{-|
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             parser/RdrHsSyn
   GhcRn/Name                rename/RnHsSyn
   GhcTc/Id                  typecheck/TcHsSyn

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 ScopedTypeVariables #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}

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

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

  -- * Constructing general big tuples
  -- $big_tuples
  mkChunkified, chunkify,

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

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

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

  -- * Types
  mkHsAppTy, mkHsAppKindTy,
  mkLHsSigType, mkLHsSigWcType, mkClassOpSigs, mkHsSigEnv,
  nlHsAppTy, nlHsAppKindTy, nlHsTyVar, nlHsFunTy, nlHsParTy, nlHsTyConApp,

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

  -- * Template Haskell
  mkUntypedSplice, mkTypedSplice,
  mkHsQuasiQuote, unqualQuasiQuote,

  -- * Collecting binders
  isUnliftedHsBind, isBangedHsBind,

  collectLocalBinders, collectHsValBinders, collectHsBindListBinders,
  collectHsIdBinders,
  collectHsBindsBinders, collectHsBindBinders, collectMethodBinders,
  collectPatBinders, collectPatsBinders,
  collectLStmtsBinders, collectStmtsBinders,
  collectLStmtBinders, collectStmtBinders,

  hsLTyClDeclBinders, hsTyClForeignBinders,
  hsPatSynSelectors, getPatSynBinds,
  hsForeignDeclsBinders, hsGroupBinders, hsDataFamInstBinders,

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

#include "HsVersions.h"

import GhcPrelude

import GHC.Hs.Decls
import GHC.Hs.Binds
import GHC.Hs.Expr
import GHC.Hs.Pat
import GHC.Hs.Types
import GHC.Hs.Lit
import GHC.Hs.PlaceHolder
import GHC.Hs.Extension

import TcEvidence
import RdrName
import Var
import TyCoRep
import Type   ( appTyArgFlags, splitAppTys, tyConArgFlags, tyConAppNeedsKindSig )
import TysWiredIn ( unitTy )
import TcType
import DataCon
import ConLike
import Id
import Name
import NameSet hiding ( unitFV )
import NameEnv
import BasicTypes
import SrcLoc
import FastString
import Util
import Bag
import Outputable
import Constants

import Data.Either
import Data.Function
import Data.List

{-
************************************************************************
*                                                                      *
        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 :: LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
mkHsPar LHsExpr (GhcPass id)
e = SrcSpan
-> SrcSpanLess (LHsExpr (GhcPass id)) -> LHsExpr (GhcPass id)
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL (LHsExpr (GhcPass id) -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc LHsExpr (GhcPass id)
e) (XPar (GhcPass id) -> LHsExpr (GhcPass id) -> HsExpr (GhcPass id)
forall p. XPar p -> LHsExpr p -> HsExpr p
HsPar XPar (GhcPass id)
NoExtField
noExtField LHsExpr (GhcPass id)
e)

mkSimpleMatch :: HsMatchContext (NameOrRdrName (IdP (GhcPass p)))
              -> [LPat (GhcPass p)] -> Located (body (GhcPass p))
              -> LMatch (GhcPass p) (Located (body (GhcPass p)))
mkSimpleMatch :: HsMatchContext (NameOrRdrName (IdP (GhcPass p)))
-> [LPat (GhcPass p)]
-> Located (body (GhcPass p))
-> LMatch (GhcPass p) (Located (body (GhcPass p)))
mkSimpleMatch HsMatchContext (NameOrRdrName (IdP (GhcPass p)))
ctxt [LPat (GhcPass p)]
pats Located (body (GhcPass p))
rhs
  = SrcSpan
-> SrcSpanLess (LMatch (GhcPass p) (Located (body (GhcPass p))))
-> LMatch (GhcPass p) (Located (body (GhcPass p)))
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
loc (SrcSpanLess (LMatch (GhcPass p) (Located (body (GhcPass p))))
 -> LMatch (GhcPass p) (Located (body (GhcPass p))))
-> SrcSpanLess (LMatch (GhcPass p) (Located (body (GhcPass p))))
-> LMatch (GhcPass p) (Located (body (GhcPass p)))
forall a b. (a -> b) -> a -> b
$
    Match :: forall p body.
XCMatch p body
-> HsMatchContext (NameOrRdrName (IdP p))
-> [LPat p]
-> GRHSs p body
-> Match p body
Match { m_ext :: XCMatch (GhcPass p) (Located (body (GhcPass p)))
m_ext = XCMatch (GhcPass p) (Located (body (GhcPass p)))
NoExtField
noExtField, m_ctxt :: HsMatchContext (NameOrRdrName (IdP (GhcPass p)))
m_ctxt = HsMatchContext (NameOrRdrName (IdP (GhcPass p)))
ctxt, m_pats :: [LPat (GhcPass p)]
m_pats = [LPat (GhcPass p)]
pats
          , m_grhss :: GRHSs (GhcPass p) (Located (body (GhcPass p)))
m_grhss = Located (body (GhcPass p))
-> GRHSs (GhcPass p) (Located (body (GhcPass p)))
forall (body :: * -> *) (p :: Pass).
Located (body (GhcPass p))
-> GRHSs (GhcPass p) (Located (body (GhcPass p)))
unguardedGRHSs Located (body (GhcPass p))
rhs }
  where
    loc :: SrcSpan
loc = case [LPat (GhcPass p)]
pats of
                []      -> Located (body (GhcPass p)) -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc Located (body (GhcPass p))
rhs
                (LPat (GhcPass p)
pat:[LPat (GhcPass p)]
_) -> SrcSpan -> SrcSpan -> SrcSpan
combineSrcSpans (Located (Pat (GhcPass p)) -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc Located (Pat (GhcPass p))
LPat (GhcPass p)
pat) (Located (body (GhcPass p)) -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc Located (body (GhcPass p))
rhs)

unguardedGRHSs :: Located (body (GhcPass p))
               -> GRHSs (GhcPass p) (Located (body (GhcPass p)))
unguardedGRHSs :: Located (body (GhcPass p))
-> GRHSs (GhcPass p) (Located (body (GhcPass p)))
unguardedGRHSs rhs :: Located (body (GhcPass p))
rhs@(Located (body (GhcPass p))
-> Located (SrcSpanLess (Located (body (GhcPass p))))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
loc SrcSpanLess (Located (body (GhcPass p)))
_)
  = XCGRHSs (GhcPass p) (Located (body (GhcPass p)))
-> [LGRHS (GhcPass p) (Located (body (GhcPass p)))]
-> LHsLocalBinds (GhcPass p)
-> GRHSs (GhcPass p) (Located (body (GhcPass p)))
forall p body.
XCGRHSs p body -> [LGRHS p body] -> LHsLocalBinds p -> GRHSs p body
GRHSs XCGRHSs (GhcPass p) (Located (body (GhcPass p)))
NoExtField
noExtField (SrcSpan
-> Located (body (GhcPass p))
-> [LGRHS (GhcPass p) (Located (body (GhcPass p)))]
forall (body :: * -> *) (p :: Pass).
SrcSpan
-> Located (body (GhcPass p))
-> [LGRHS (GhcPass p) (Located (body (GhcPass p)))]
unguardedRHS SrcSpan
loc Located (body (GhcPass p))
rhs) (SrcSpanLess (LHsLocalBinds (GhcPass p))
-> LHsLocalBinds (GhcPass p)
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc SrcSpanLess (LHsLocalBinds (GhcPass p))
forall (a :: Pass) (b :: Pass).
HsLocalBindsLR (GhcPass a) (GhcPass b)
emptyLocalBinds)

unguardedRHS :: SrcSpan -> Located (body (GhcPass p))
             -> [LGRHS (GhcPass p) (Located (body (GhcPass p)))]
unguardedRHS :: SrcSpan
-> Located (body (GhcPass p))
-> [LGRHS (GhcPass p) (Located (body (GhcPass p)))]
unguardedRHS SrcSpan
loc Located (body (GhcPass p))
rhs = [SrcSpan
-> SrcSpanLess (LGRHS (GhcPass p) (Located (body (GhcPass p))))
-> LGRHS (GhcPass p) (Located (body (GhcPass p)))
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
loc (XCGRHS (GhcPass p) (Located (body (GhcPass p)))
-> [GuardLStmt (GhcPass p)]
-> Located (body (GhcPass p))
-> GRHS (GhcPass p) (Located (body (GhcPass p)))
forall p body.
XCGRHS p body -> [GuardLStmt p] -> body -> GRHS p body
GRHS XCGRHS (GhcPass p) (Located (body (GhcPass p)))
NoExtField
noExtField [] Located (body (GhcPass p))
rhs)]

mkMatchGroup :: (XMG name (Located (body name)) ~ NoExtField)
             => Origin -> [LMatch name (Located (body name))]
             -> MatchGroup name (Located (body name))
mkMatchGroup :: Origin
-> [LMatch name (Located (body name))]
-> MatchGroup name (Located (body name))
mkMatchGroup Origin
origin [LMatch name (Located (body name))]
matches = MG :: forall p body.
XMG p body
-> Located [LMatch p body] -> Origin -> MatchGroup p body
MG { mg_ext :: XMG name (Located (body name))
mg_ext = XMG name (Located (body name))
NoExtField
noExtField
                                 , mg_alts :: Located [LMatch name (Located (body name))]
mg_alts = [LMatch name (Located (body name))]
-> Located [LMatch name (Located (body name))]
forall a. [Located a] -> Located [Located a]
mkLocatedList [LMatch name (Located (body name))]
matches
                                 , mg_origin :: Origin
mg_origin = Origin
origin }

mkLocatedList ::  [Located a] -> Located [Located a]
mkLocatedList :: [Located a] -> Located [Located a]
mkLocatedList [] = SrcSpanLess (Located [Located a]) -> Located [Located a]
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc []
mkLocatedList [Located a]
ms = SrcSpan -> SrcSpanLess (Located [Located a]) -> Located [Located a]
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL (Located a -> Located a -> SrcSpan
forall a b. (HasSrcSpan a, HasSrcSpan b) => a -> b -> SrcSpan
combineLocs ([Located a] -> Located a
forall a. [a] -> a
head [Located a]
ms) ([Located a] -> Located a
forall a. [a] -> a
last [Located a]
ms)) [Located a]
SrcSpanLess (Located [Located a])
ms

mkHsApp :: LHsExpr (GhcPass id) -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
mkHsApp :: LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
mkHsApp LHsExpr (GhcPass id)
e1 LHsExpr (GhcPass id)
e2 = LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id)
-> SrcSpanLess (LHsExpr (GhcPass id))
-> LHsExpr (GhcPass id)
forall a b c.
(HasSrcSpan a, HasSrcSpan b, HasSrcSpan c) =>
a -> b -> SrcSpanLess c -> c
addCLoc 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)
NoExtField
noExtField LHsExpr (GhcPass id)
e1 LHsExpr (GhcPass id)
e2)

mkHsAppType :: (NoGhcTc (GhcPass id) ~ GhcRn)
            => LHsExpr (GhcPass id) -> LHsWcType GhcRn -> LHsExpr (GhcPass id)
mkHsAppType :: LHsExpr (GhcPass id) -> LHsWcType GhcRn -> LHsExpr (GhcPass id)
mkHsAppType LHsExpr (GhcPass id)
e LHsWcType GhcRn
t = LHsExpr (GhcPass id)
-> LHsType GhcRn
-> SrcSpanLess (LHsExpr (GhcPass id))
-> LHsExpr (GhcPass id)
forall a b c.
(HasSrcSpan a, HasSrcSpan b, HasSrcSpan c) =>
a -> b -> SrcSpanLess c -> c
addCLoc LHsExpr (GhcPass id)
e LHsType GhcRn
t_body (XAppTypeE (GhcPass id)
-> LHsExpr (GhcPass id)
-> LHsWcType (NoGhcTc (GhcPass id))
-> HsExpr (GhcPass id)
forall p.
XAppTypeE p -> LHsExpr p -> LHsWcType (NoGhcTc p) -> HsExpr p
HsAppType XAppTypeE (GhcPass id)
NoExtField
noExtField LHsExpr (GhcPass id)
e LHsWcType (NoGhcTc (GhcPass id))
LHsWcType GhcRn
paren_wct)
  where
    t_body :: LHsType GhcRn
t_body    = LHsWcType GhcRn -> LHsType GhcRn
forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body LHsWcType GhcRn
t
    paren_wct :: LHsWcType GhcRn
paren_wct = LHsWcType GhcRn
t { hswc_body :: LHsType GhcRn
hswc_body = PprPrec -> LHsType GhcRn -> LHsType GhcRn
forall (p :: Pass).
PprPrec -> LHsType (GhcPass p) -> LHsType (GhcPass p)
parenthesizeHsType PprPrec
appPrec LHsType GhcRn
t_body }

mkHsAppTypes :: LHsExpr GhcRn -> [LHsWcType GhcRn] -> LHsExpr GhcRn
mkHsAppTypes :: LHsExpr GhcRn -> [LHsWcType GhcRn] -> LHsExpr GhcRn
mkHsAppTypes = (LHsExpr GhcRn -> LHsWcType GhcRn -> LHsExpr GhcRn)
-> LHsExpr GhcRn -> [LHsWcType GhcRn] -> LHsExpr GhcRn
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' LHsExpr GhcRn -> LHsWcType GhcRn -> LHsExpr GhcRn
forall (id :: Pass).
(NoGhcTc (GhcPass id) ~ GhcRn) =>
LHsExpr (GhcPass id) -> LHsWcType GhcRn -> LHsExpr (GhcPass id)
mkHsAppType

mkHsLam :: (XMG (GhcPass p) (LHsExpr (GhcPass p)) ~ NoExtField) =>
  [LPat (GhcPass p)] -> LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
mkHsLam :: [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 (SrcSpan -> SrcSpanLess (LHsExpr (GhcPass p)) -> LHsExpr (GhcPass p)
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL (LHsExpr (GhcPass p) -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc LHsExpr (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))
matches))
  where
    matches :: MatchGroup (GhcPass p) (LHsExpr (GhcPass p))
matches = Origin
-> [LMatch (GhcPass p) (LHsExpr (GhcPass p))]
-> MatchGroup (GhcPass p) (LHsExpr (GhcPass p))
forall name (body :: * -> *).
(XMG name (Located (body name)) ~ NoExtField) =>
Origin
-> [LMatch name (Located (body name))]
-> MatchGroup name (Located (body name))
mkMatchGroup Origin
Generated
                           [HsMatchContext (NameOrRdrName (IdP (GhcPass p)))
-> [LPat (GhcPass p)]
-> LHsExpr (GhcPass p)
-> LMatch (GhcPass p) (LHsExpr (GhcPass p))
forall (p :: Pass) (body :: * -> *).
HsMatchContext (NameOrRdrName (IdP (GhcPass p)))
-> [LPat (GhcPass p)]
-> Located (body (GhcPass p))
-> LMatch (GhcPass p) (Located (body (GhcPass p)))
mkSimpleMatch HsMatchContext (NameOrRdrName (IdP (GhcPass p)))
forall id. HsMatchContext id
LambdaExpr [Located (Pat (GhcPass p))]
[LPat (GhcPass p)]
pats' LHsExpr (GhcPass p)
body]
    pats' :: [Located (Pat (GhcPass p))]
pats' = (Located (Pat (GhcPass p)) -> Located (Pat (GhcPass p)))
-> [Located (Pat (GhcPass p))] -> [Located (Pat (GhcPass p))]
forall a b. (a -> b) -> [a] -> [b]
map (PprPrec -> LPat (GhcPass p) -> LPat (GhcPass p)
forall (p :: Pass). PprPrec -> LPat (GhcPass p) -> LPat (GhcPass p)
parenthesizePat PprPrec
appPrec) [Located (Pat (GhcPass p))]
[LPat (GhcPass p)]
pats

mkHsLams :: [TyVar] -> [EvVar] -> LHsExpr GhcTc -> LHsExpr GhcTc
mkHsLams :: [TyVar] -> [TyVar] -> LHsExpr GhcTc -> LHsExpr GhcTc
mkHsLams [TyVar]
tyvars [TyVar]
dicts LHsExpr GhcTc
expr = HsWrapper -> LHsExpr GhcTc -> LHsExpr GhcTc
forall (id :: Pass).
HsWrapper -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
mkLHsWrap ([TyVar] -> HsWrapper
mkWpTyLams [TyVar]
tyvars
                                       HsWrapper -> HsWrapper -> HsWrapper
<.> [TyVar] -> HsWrapper
mkWpLams [TyVar]
dicts) LHsExpr GhcTc
expr

-- |A simple case alternative with a single pattern, no binds, no guards;
-- pre-typechecking
mkHsCaseAlt :: LPat (GhcPass p) -> (Located (body (GhcPass p)))
            -> LMatch (GhcPass p) (Located (body (GhcPass p)))
mkHsCaseAlt :: LPat (GhcPass p)
-> Located (body (GhcPass p))
-> LMatch (GhcPass p) (Located (body (GhcPass p)))
mkHsCaseAlt LPat (GhcPass p)
pat Located (body (GhcPass p))
expr
  = HsMatchContext (NameOrRdrName (IdP (GhcPass p)))
-> [LPat (GhcPass p)]
-> Located (body (GhcPass p))
-> LMatch (GhcPass p) (Located (body (GhcPass p)))
forall (p :: Pass) (body :: * -> *).
HsMatchContext (NameOrRdrName (IdP (GhcPass p)))
-> [LPat (GhcPass p)]
-> Located (body (GhcPass p))
-> LMatch (GhcPass p) (Located (body (GhcPass p)))
mkSimpleMatch HsMatchContext (NameOrRdrName (IdP (GhcPass p)))
forall id. HsMatchContext id
CaseAlt [LPat (GhcPass p)
pat] Located (body (GhcPass p))
expr

nlHsTyApp :: IdP (GhcPass id) -> [Type] -> LHsExpr (GhcPass id)
nlHsTyApp :: IdP (GhcPass id) -> [Type] -> LHsExpr (GhcPass id)
nlHsTyApp IdP (GhcPass id)
fun_id [Type]
tys
  = SrcSpanLess (LHsExpr (GhcPass id)) -> LHsExpr (GhcPass id)
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (HsWrapper -> HsExpr (GhcPass id) -> HsExpr (GhcPass id)
forall (id :: Pass).
HsWrapper -> HsExpr (GhcPass id) -> HsExpr (GhcPass id)
mkHsWrap ([Type] -> HsWrapper
mkWpTyApps [Type]
tys) (XVar (GhcPass id)
-> Located (IdP (GhcPass id)) -> HsExpr (GhcPass id)
forall p. XVar p -> Located (IdP p) -> HsExpr p
HsVar XVar (GhcPass id)
NoExtField
noExtField (SrcSpanLess (Located (IdP (GhcPass id)))
-> Located (IdP (GhcPass id))
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc SrcSpanLess (Located (IdP (GhcPass id)))
IdP (GhcPass id)
fun_id)))

nlHsTyApps :: IdP (GhcPass id) -> [Type] -> [LHsExpr (GhcPass id)]
           -> LHsExpr (GhcPass id)
nlHsTyApps :: IdP (GhcPass id)
-> [Type] -> [LHsExpr (GhcPass id)] -> LHsExpr (GhcPass id)
nlHsTyApps IdP (GhcPass id)
fun_id [Type]
tys [LHsExpr (GhcPass id)]
xs = (LHsExpr (GhcPass id)
 -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id))
-> LHsExpr (GhcPass id)
-> [LHsExpr (GhcPass id)]
-> LHsExpr (GhcPass id)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
forall (id :: Pass).
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
nlHsApp (IdP (GhcPass id) -> [Type] -> LHsExpr (GhcPass id)
forall (id :: Pass).
IdP (GhcPass id) -> [Type] -> LHsExpr (GhcPass id)
nlHsTyApp IdP (GhcPass id)
fun_id [Type]
tys) [LHsExpr (GhcPass id)]
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 :: LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
mkLHsPar :: LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
mkLHsPar le :: LHsExpr (GhcPass id)
le@(LHsExpr (GhcPass id)
-> Located (SrcSpanLess (LHsExpr (GhcPass id)))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
loc SrcSpanLess (LHsExpr (GhcPass id))
e)
  | PprPrec -> HsExpr (GhcPass id) -> Bool
forall p. PprPrec -> HsExpr p -> Bool
hsExprNeedsParens PprPrec
appPrec SrcSpanLess (LHsExpr (GhcPass id))
HsExpr (GhcPass id)
e = SrcSpan
-> SrcSpanLess (LHsExpr (GhcPass id)) -> LHsExpr (GhcPass id)
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
loc (XPar (GhcPass id) -> LHsExpr (GhcPass id) -> HsExpr (GhcPass id)
forall p. XPar p -> LHsExpr p -> HsExpr p
HsPar XPar (GhcPass id)
NoExtField
noExtField LHsExpr (GhcPass id)
le)
  | Bool
otherwise                   = LHsExpr (GhcPass id)
le

mkParPat :: LPat (GhcPass name) -> LPat (GhcPass name)
mkParPat :: LPat (GhcPass name) -> LPat (GhcPass name)
mkParPat lp :: LPat (GhcPass name)
lp@(LPat (GhcPass name)
-> Located (SrcSpanLess (Located (Pat (GhcPass name))))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
loc SrcSpanLess (Located (Pat (GhcPass name)))
p)
  | PprPrec -> Pat (GhcPass name) -> Bool
forall p. PprPrec -> Pat p -> Bool
patNeedsParens PprPrec
appPrec SrcSpanLess (Located (Pat (GhcPass name)))
Pat (GhcPass name)
p = SrcSpan
-> SrcSpanLess (Located (Pat (GhcPass name)))
-> Located (Pat (GhcPass name))
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
loc (XParPat (GhcPass name) -> LPat (GhcPass name) -> Pat (GhcPass name)
forall p. XParPat p -> LPat p -> Pat p
ParPat XParPat (GhcPass name)
NoExtField
noExtField LPat (GhcPass name)
lp)
  | Bool
otherwise                = LPat (GhcPass name)
lp

nlParPat :: LPat (GhcPass name) -> LPat (GhcPass name)
nlParPat :: LPat (GhcPass name) -> LPat (GhcPass name)
nlParPat LPat (GhcPass name)
p = SrcSpanLess (Located (Pat (GhcPass name)))
-> Located (Pat (GhcPass name))
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (XParPat (GhcPass name) -> LPat (GhcPass name) -> Pat (GhcPass name)
forall p. XParPat p -> LPat p -> Pat p
ParPat XParPat (GhcPass name)
NoExtField
noExtField LPat (GhcPass name)
p)

-------------------------------
-- These are the bits of syntax that contain rebindable names
-- See RnEnv.lookupSyntaxName

mkHsIntegral   :: IntegralLit -> HsOverLit GhcPs
mkHsFractional :: FractionalLit -> HsOverLit GhcPs
mkHsIsString   :: SourceText -> FastString -> HsOverLit GhcPs
mkHsDo         :: HsStmtContext Name -> [ExprLStmt GhcPs] -> HsExpr GhcPs
mkHsComp       :: HsStmtContext Name -> [ExprLStmt GhcPs] -> LHsExpr GhcPs
               -> HsExpr GhcPs

mkNPat      :: Located (HsOverLit GhcPs) -> Maybe (SyntaxExpr GhcPs)
            -> Pat GhcPs
mkNPlusKPat :: Located RdrName -> Located (HsOverLit GhcPs) -> Pat GhcPs

mkLastStmt :: Located (bodyR (GhcPass idR))
           -> StmtLR (GhcPass idL) (GhcPass idR) (Located (bodyR (GhcPass idR)))
mkBodyStmt :: Located (bodyR GhcPs)
           -> StmtLR (GhcPass idL) GhcPs (Located (bodyR GhcPs))
mkBindStmt :: (XBindStmt (GhcPass idL) (GhcPass idR)
                         (Located (bodyR (GhcPass idR))) ~ NoExtField)
           => LPat (GhcPass idL) -> Located (bodyR (GhcPass idR))
           -> StmtLR (GhcPass idL) (GhcPass idR) (Located (bodyR (GhcPass idR)))
mkTcBindStmt :: LPat GhcTc -> Located (bodyR GhcTc)
             -> StmtLR GhcTc GhcTc (Located (bodyR GhcTc))

emptyRecStmt     :: StmtLR (GhcPass idL) GhcPs bodyR
emptyRecStmtName :: StmtLR GhcRn GhcRn bodyR
emptyRecStmtId   :: StmtLR GhcTc GhcTc bodyR
mkRecStmt        :: [LStmtLR (GhcPass idL) GhcPs bodyR]
                 -> StmtLR (GhcPass idL) GhcPs bodyR


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

mkHsDo :: HsStmtContext Name -> [ExprLStmt GhcPs] -> HsExpr GhcPs
mkHsDo HsStmtContext Name
ctxt [ExprLStmt GhcPs]
stmts = XDo GhcPs
-> HsStmtContext Name -> Located [ExprLStmt GhcPs] -> HsExpr GhcPs
forall p.
XDo p -> HsStmtContext Name -> Located [ExprLStmt p] -> HsExpr p
HsDo XDo GhcPs
NoExtField
noExtField HsStmtContext Name
ctxt ([ExprLStmt GhcPs] -> Located [ExprLStmt GhcPs]
forall a. [Located a] -> Located [Located a]
mkLocatedList [ExprLStmt GhcPs]
stmts)
mkHsComp :: HsStmtContext Name
-> [ExprLStmt GhcPs] -> LHsExpr GhcPs -> HsExpr GhcPs
mkHsComp HsStmtContext Name
ctxt [ExprLStmt GhcPs]
stmts LHsExpr GhcPs
expr = HsStmtContext Name -> [ExprLStmt GhcPs] -> HsExpr GhcPs
mkHsDo HsStmtContext Name
ctxt ([ExprLStmt GhcPs]
stmts [ExprLStmt GhcPs] -> [ExprLStmt GhcPs] -> [ExprLStmt GhcPs]
forall a. [a] -> [a] -> [a]
++ [ExprLStmt GhcPs
last_stmt])
  where
    last_stmt :: ExprLStmt GhcPs
last_stmt = SrcSpan -> SrcSpanLess (ExprLStmt GhcPs) -> ExprLStmt GhcPs
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL (LHsExpr GhcPs -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc LHsExpr GhcPs
expr) (SrcSpanLess (ExprLStmt GhcPs) -> ExprLStmt GhcPs)
-> SrcSpanLess (ExprLStmt GhcPs) -> ExprLStmt GhcPs
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> StmtLR GhcPs GhcPs (LHsExpr GhcPs)
forall (bodyR :: * -> *) (idR :: Pass) (idL :: Pass).
Located (bodyR (GhcPass idR))
-> StmtLR
     (GhcPass idL) (GhcPass idR) (Located (bodyR (GhcPass idR)))
mkLastStmt LHsExpr GhcPs
expr

mkHsIf :: LHsExpr (GhcPass p) -> LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
       -> HsExpr (GhcPass p)
mkHsIf :: LHsExpr (GhcPass p)
-> LHsExpr (GhcPass p) -> LHsExpr (GhcPass p) -> HsExpr (GhcPass p)
mkHsIf LHsExpr (GhcPass p)
c LHsExpr (GhcPass p)
a LHsExpr (GhcPass p)
b = XIf (GhcPass p)
-> Maybe (SyntaxExpr (GhcPass p))
-> LHsExpr (GhcPass p)
-> LHsExpr (GhcPass p)
-> LHsExpr (GhcPass p)
-> HsExpr (GhcPass p)
forall p.
XIf p
-> Maybe (SyntaxExpr p)
-> LHsExpr p
-> LHsExpr p
-> LHsExpr p
-> HsExpr p
HsIf XIf (GhcPass p)
NoExtField
noExtField (SyntaxExpr (GhcPass p) -> Maybe (SyntaxExpr (GhcPass p))
forall a. a -> Maybe a
Just SyntaxExpr (GhcPass p)
forall (p :: Pass). SyntaxExpr (GhcPass p)
noSyntaxExpr) LHsExpr (GhcPass p)
c LHsExpr (GhcPass p)
a LHsExpr (GhcPass p)
b

mkHsCmdIf :: LHsExpr (GhcPass p) -> LHsCmd (GhcPass p) -> LHsCmd (GhcPass p)
       -> HsCmd (GhcPass p)
mkHsCmdIf :: LHsExpr (GhcPass p)
-> LHsCmd (GhcPass p) -> LHsCmd (GhcPass p) -> HsCmd (GhcPass p)
mkHsCmdIf LHsExpr (GhcPass p)
c LHsCmd (GhcPass p)
a LHsCmd (GhcPass p)
b = XCmdIf (GhcPass p)
-> Maybe (SyntaxExpr (GhcPass p))
-> LHsExpr (GhcPass p)
-> LHsCmd (GhcPass p)
-> LHsCmd (GhcPass p)
-> HsCmd (GhcPass p)
forall id.
XCmdIf id
-> Maybe (SyntaxExpr id)
-> LHsExpr id
-> LHsCmd id
-> LHsCmd id
-> HsCmd id
HsCmdIf XCmdIf (GhcPass p)
NoExtField
noExtField (SyntaxExpr (GhcPass p) -> Maybe (SyntaxExpr (GhcPass p))
forall a. a -> Maybe a
Just SyntaxExpr (GhcPass p)
forall (p :: Pass). SyntaxExpr (GhcPass p)
noSyntaxExpr) LHsExpr (GhcPass p)
c LHsCmd (GhcPass p)
a LHsCmd (GhcPass p)
b

mkNPat :: Located (HsOverLit GhcPs) -> Maybe (SyntaxExpr GhcPs) -> Pat GhcPs
mkNPat Located (HsOverLit GhcPs)
lit Maybe (SyntaxExpr GhcPs)
neg     = XNPat GhcPs
-> Located (HsOverLit GhcPs)
-> Maybe (SyntaxExpr GhcPs)
-> SyntaxExpr GhcPs
-> Pat GhcPs
forall p.
XNPat p
-> Located (HsOverLit p)
-> Maybe (SyntaxExpr p)
-> SyntaxExpr p
-> Pat p
NPat XNPat GhcPs
NoExtField
noExtField Located (HsOverLit GhcPs)
lit Maybe (SyntaxExpr GhcPs)
neg SyntaxExpr GhcPs
forall (p :: Pass). SyntaxExpr (GhcPass p)
noSyntaxExpr
mkNPlusKPat :: Located RdrName -> Located (HsOverLit GhcPs) -> Pat GhcPs
mkNPlusKPat Located RdrName
id Located (HsOverLit GhcPs)
lit
  = XNPlusKPat GhcPs
-> Located (IdP GhcPs)
-> Located (HsOverLit GhcPs)
-> HsOverLit GhcPs
-> SyntaxExpr GhcPs
-> SyntaxExpr GhcPs
-> Pat GhcPs
forall p.
XNPlusKPat p
-> Located (IdP p)
-> Located (HsOverLit p)
-> HsOverLit p
-> SyntaxExpr p
-> SyntaxExpr p
-> Pat p
NPlusKPat XNPlusKPat GhcPs
NoExtField
noExtField Located RdrName
Located (IdP GhcPs)
id Located (HsOverLit GhcPs)
lit (Located (HsOverLit GhcPs)
-> SrcSpanLess (Located (HsOverLit GhcPs))
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located (HsOverLit GhcPs)
lit) SyntaxExpr GhcPs
forall (p :: Pass). SyntaxExpr (GhcPass p)
noSyntaxExpr SyntaxExpr GhcPs
forall (p :: Pass). SyntaxExpr (GhcPass p)
noSyntaxExpr

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

emptyTransStmt :: StmtLR GhcPs GhcPs (LHsExpr GhcPs)
emptyTransStmt :: StmtLR GhcPs GhcPs (LHsExpr GhcPs)
emptyTransStmt = TransStmt :: forall idL idR body.
XTransStmt idL idR body
-> TransForm
-> [ExprLStmt idL]
-> [(IdP idR, IdP idR)]
-> LHsExpr idR
-> Maybe (LHsExpr idR)
-> SyntaxExpr idR
-> SyntaxExpr idR
-> HsExpr idR
-> StmtLR idL idR body
TransStmt { trS_ext :: XTransStmt GhcPs GhcPs (LHsExpr GhcPs)
trS_ext = XTransStmt GhcPs GhcPs (LHsExpr GhcPs)
NoExtField
noExtField
                           , trS_form :: TransForm
trS_form = String -> TransForm
forall a. 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)
forall a. Maybe a
Nothing, trS_using :: LHsExpr GhcPs
trS_using = SrcSpanLess (LHsExpr GhcPs) -> LHsExpr GhcPs
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc SrcSpanLess (LHsExpr GhcPs)
forall (p :: Pass). HsExpr (GhcPass p)
noExpr
                           , trS_ret :: SyntaxExpr GhcPs
trS_ret = SyntaxExpr GhcPs
forall (p :: Pass). SyntaxExpr (GhcPass p)
noSyntaxExpr, trS_bind :: SyntaxExpr GhcPs
trS_bind = SyntaxExpr GhcPs
forall (p :: Pass). SyntaxExpr (GhcPass p)
noSyntaxExpr
                           , trS_fmap :: HsExpr GhcPs
trS_fmap = HsExpr GhcPs
forall (p :: Pass). HsExpr (GhcPass p)
noExpr }
mkTransformStmt :: [ExprLStmt GhcPs]
-> LHsExpr GhcPs -> StmtLR GhcPs GhcPs (LHsExpr GhcPs)
mkTransformStmt    [ExprLStmt GhcPs]
ss LHsExpr GhcPs
u   = StmtLR GhcPs GhcPs (LHsExpr GhcPs)
emptyTransStmt { trS_form :: TransForm
trS_form = TransForm
ThenForm,  trS_stmts :: [ExprLStmt GhcPs]
trS_stmts = [ExprLStmt GhcPs]
ss, trS_using :: LHsExpr GhcPs
trS_using = LHsExpr GhcPs
u }
mkTransformByStmt :: [ExprLStmt GhcPs]
-> LHsExpr GhcPs
-> LHsExpr GhcPs
-> StmtLR GhcPs GhcPs (LHsExpr GhcPs)
mkTransformByStmt  [ExprLStmt GhcPs]
ss LHsExpr GhcPs
u LHsExpr GhcPs
b = StmtLR GhcPs GhcPs (LHsExpr GhcPs)
emptyTransStmt { trS_form :: TransForm
trS_form = TransForm
ThenForm,  trS_stmts :: [ExprLStmt GhcPs]
trS_stmts = [ExprLStmt GhcPs]
ss, trS_using :: LHsExpr GhcPs
trS_using = LHsExpr GhcPs
u, trS_by :: Maybe (LHsExpr GhcPs)
trS_by = LHsExpr GhcPs -> Maybe (LHsExpr GhcPs)
forall a. a -> Maybe a
Just LHsExpr GhcPs
b }
mkGroupUsingStmt :: [ExprLStmt GhcPs]
-> LHsExpr GhcPs -> StmtLR GhcPs GhcPs (LHsExpr GhcPs)
mkGroupUsingStmt   [ExprLStmt GhcPs]
ss LHsExpr GhcPs
u   = StmtLR GhcPs GhcPs (LHsExpr GhcPs)
emptyTransStmt { trS_form :: TransForm
trS_form = TransForm
GroupForm, trS_stmts :: [ExprLStmt GhcPs]
trS_stmts = [ExprLStmt GhcPs]
ss, trS_using :: LHsExpr GhcPs
trS_using = LHsExpr GhcPs
u }
mkGroupByUsingStmt :: [ExprLStmt GhcPs]
-> LHsExpr GhcPs
-> LHsExpr GhcPs
-> StmtLR GhcPs GhcPs (LHsExpr GhcPs)
mkGroupByUsingStmt [ExprLStmt GhcPs]
ss LHsExpr GhcPs
b LHsExpr GhcPs
u = StmtLR GhcPs GhcPs (LHsExpr GhcPs)
emptyTransStmt { trS_form :: TransForm
trS_form = TransForm
GroupForm, trS_stmts :: [ExprLStmt GhcPs]
trS_stmts = [ExprLStmt GhcPs]
ss, trS_using :: LHsExpr GhcPs
trS_using = LHsExpr GhcPs
u, trS_by :: Maybe (LHsExpr GhcPs)
trS_by = LHsExpr GhcPs -> Maybe (LHsExpr GhcPs)
forall a. a -> Maybe a
Just LHsExpr GhcPs
b }

mkLastStmt :: Located (bodyR (GhcPass idR))
-> StmtLR
     (GhcPass idL) (GhcPass idR) (Located (bodyR (GhcPass idR)))
mkLastStmt Located (bodyR (GhcPass idR))
body = XLastStmt
  (GhcPass idL) (GhcPass idR) (Located (bodyR (GhcPass idR)))
-> Located (bodyR (GhcPass idR))
-> Bool
-> SyntaxExpr (GhcPass idR)
-> StmtLR
     (GhcPass idL) (GhcPass idR) (Located (bodyR (GhcPass idR)))
forall idL idR body.
XLastStmt idL idR body
-> body -> Bool -> SyntaxExpr idR -> StmtLR idL idR body
LastStmt XLastStmt
  (GhcPass idL) (GhcPass idR) (Located (bodyR (GhcPass idR)))
NoExtField
noExtField Located (bodyR (GhcPass idR))
body Bool
False SyntaxExpr (GhcPass idR)
forall (p :: Pass). SyntaxExpr (GhcPass p)
noSyntaxExpr
mkBodyStmt :: Located (bodyR GhcPs)
-> StmtLR (GhcPass idL) GhcPs (Located (bodyR GhcPs))
mkBodyStmt Located (bodyR GhcPs)
body
  = XBodyStmt (GhcPass idL) GhcPs (Located (bodyR GhcPs))
-> Located (bodyR GhcPs)
-> SyntaxExpr GhcPs
-> SyntaxExpr GhcPs
-> StmtLR (GhcPass idL) GhcPs (Located (bodyR GhcPs))
forall idL idR body.
XBodyStmt idL idR body
-> body -> SyntaxExpr idR -> SyntaxExpr idR -> StmtLR idL idR body
BodyStmt XBodyStmt (GhcPass idL) GhcPs (Located (bodyR GhcPs))
NoExtField
noExtField Located (bodyR GhcPs)
body SyntaxExpr GhcPs
forall (p :: Pass). SyntaxExpr (GhcPass p)
noSyntaxExpr SyntaxExpr GhcPs
forall (p :: Pass). SyntaxExpr (GhcPass p)
noSyntaxExpr
mkBindStmt :: LPat (GhcPass idL)
-> Located (bodyR (GhcPass idR))
-> StmtLR
     (GhcPass idL) (GhcPass idR) (Located (bodyR (GhcPass idR)))
mkBindStmt LPat (GhcPass idL)
pat Located (bodyR (GhcPass idR))
body
  = XBindStmt
  (GhcPass idL) (GhcPass idR) (Located (bodyR (GhcPass idR)))
-> LPat (GhcPass idL)
-> Located (bodyR (GhcPass idR))
-> SyntaxExpr (GhcPass idR)
-> SyntaxExpr (GhcPass idR)
-> StmtLR
     (GhcPass idL) (GhcPass idR) (Located (bodyR (GhcPass idR)))
forall idL idR body.
XBindStmt idL idR body
-> LPat idL
-> body
-> SyntaxExpr idR
-> SyntaxExpr idR
-> StmtLR idL idR body
BindStmt XBindStmt
  (GhcPass idL) (GhcPass idR) (Located (bodyR (GhcPass idR)))
NoExtField
noExtField LPat (GhcPass idL)
pat Located (bodyR (GhcPass idR))
body SyntaxExpr (GhcPass idR)
forall (p :: Pass). SyntaxExpr (GhcPass p)
noSyntaxExpr SyntaxExpr (GhcPass idR)
forall (p :: Pass). SyntaxExpr (GhcPass p)
noSyntaxExpr
mkTcBindStmt :: LPat GhcTc
-> Located (bodyR GhcTc)
-> StmtLR GhcTc GhcTc (Located (bodyR GhcTc))
mkTcBindStmt LPat GhcTc
pat Located (bodyR GhcTc)
body = XBindStmt GhcTc GhcTc (Located (bodyR GhcTc))
-> LPat GhcTc
-> Located (bodyR GhcTc)
-> SyntaxExpr GhcTc
-> SyntaxExpr GhcTc
-> StmtLR GhcTc GhcTc (Located (bodyR GhcTc))
forall idL idR body.
XBindStmt idL idR body
-> LPat idL
-> body
-> SyntaxExpr idR
-> SyntaxExpr idR
-> StmtLR idL idR body
BindStmt Type
XBindStmt GhcTc GhcTc (Located (bodyR GhcTc))
unitTy LPat GhcTc
pat Located (bodyR GhcTc)
body SyntaxExpr GhcTc
forall (p :: Pass). SyntaxExpr (GhcPass p)
noSyntaxExpr SyntaxExpr GhcTc
forall (p :: Pass). SyntaxExpr (GhcPass p)
noSyntaxExpr
  -- don't use placeHolderTypeTc above, because that panics during zonking

emptyRecStmt' :: forall idL idR body.
                 XRecStmt (GhcPass idL) (GhcPass idR) body
              -> StmtLR (GhcPass idL) (GhcPass idR) body
emptyRecStmt' :: XRecStmt (GhcPass idL) (GhcPass idR) body
-> StmtLR (GhcPass idL) (GhcPass idR) body
emptyRecStmt' XRecStmt (GhcPass idL) (GhcPass idR) body
tyVal =
   RecStmt :: forall idL idR body.
XRecStmt idL idR body
-> [LStmtLR idL idR body]
-> [IdP idR]
-> [IdP idR]
-> SyntaxExpr idR
-> SyntaxExpr idR
-> SyntaxExpr idR
-> StmtLR idL idR body
RecStmt
     { recS_stmts :: [LStmtLR (GhcPass idL) (GhcPass idR) body]
recS_stmts = [], 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). SyntaxExpr (GhcPass p)
noSyntaxExpr
     , recS_mfix_fn :: SyntaxExpr (GhcPass idR)
recS_mfix_fn = SyntaxExpr (GhcPass idR)
forall (p :: Pass). SyntaxExpr (GhcPass p)
noSyntaxExpr
     , recS_bind_fn :: SyntaxExpr (GhcPass idR)
recS_bind_fn = SyntaxExpr (GhcPass idR)
forall (p :: Pass). 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 :: Type -> [PostTcExpr] -> [PostTcExpr] -> Type -> RecStmtTc
RecStmtTc { recS_bind_ty :: Type
recS_bind_ty = Type
unitTy
                          , recS_later_rets :: [PostTcExpr]
recS_later_rets = []
                          , recS_rec_rets :: [PostTcExpr]
recS_rec_rets = []
                          , recS_ret_ty :: Type
recS_ret_ty = Type
unitTy }

emptyRecStmt :: StmtLR (GhcPass idL) GhcPs bodyR
emptyRecStmt     = XRecStmt (GhcPass idL) GhcPs bodyR
-> StmtLR (GhcPass idL) GhcPs bodyR
forall (idL :: Pass) (idR :: Pass) body.
XRecStmt (GhcPass idL) (GhcPass idR) body
-> StmtLR (GhcPass idL) (GhcPass idR) body
emptyRecStmt' XRecStmt (GhcPass idL) GhcPs bodyR
NoExtField
noExtField
emptyRecStmtName :: StmtLR GhcRn GhcRn bodyR
emptyRecStmtName = XRecStmt GhcRn GhcRn bodyR -> StmtLR GhcRn GhcRn bodyR
forall (idL :: Pass) (idR :: Pass) body.
XRecStmt (GhcPass idL) (GhcPass idR) body
-> StmtLR (GhcPass idL) (GhcPass idR) body
emptyRecStmt' XRecStmt GhcRn GhcRn bodyR
NoExtField
noExtField
emptyRecStmtId :: StmtLR GhcTc GhcTc bodyR
emptyRecStmtId   = XRecStmt GhcTc GhcTc bodyR -> StmtLR GhcTc GhcTc bodyR
forall (idL :: Pass) (idR :: Pass) body.
XRecStmt (GhcPass idL) (GhcPass idR) body
-> StmtLR (GhcPass idL) (GhcPass idR) body
emptyRecStmt' XRecStmt GhcTc GhcTc bodyR
RecStmtTc
unitRecStmtTc
                                        -- a panic might trigger during zonking
mkRecStmt :: [LStmtLR (GhcPass idL) GhcPs bodyR]
-> StmtLR (GhcPass idL) GhcPs bodyR
mkRecStmt [LStmtLR (GhcPass idL) GhcPs bodyR]
stmts  = StmtLR (GhcPass idL) GhcPs bodyR
forall (idL :: Pass) bodyR. StmtLR (GhcPass idL) GhcPs bodyR
emptyRecStmt { recS_stmts :: [LStmtLR (GhcPass idL) GhcPs bodyR]
recS_stmts = [LStmtLR (GhcPass idL) GhcPs bodyR]
stmts }

-------------------------------
-- | 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
NoExtField
noExtField LHsExpr GhcPs
e1 (SrcSpanLess (LHsExpr GhcPs) -> LHsExpr GhcPs
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (XVar GhcPs -> Located (IdP GhcPs) -> HsExpr GhcPs
forall p. XVar p -> Located (IdP p) -> HsExpr p
HsVar XVar GhcPs
NoExtField
noExtField (SrcSpanLess (Located RdrName) -> Located RdrName
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc SrcSpanLess (Located RdrName)
IdP GhcPs
op))) LHsExpr GhcPs
e2

unqualSplice :: RdrName
unqualSplice :: RdrName
unqualSplice = OccName -> RdrName
mkRdrUnqual (FastString -> OccName
mkVarOccFS (String -> FastString
fsLit String
"splice"))

mkUntypedSplice :: SpliceDecoration -> LHsExpr GhcPs -> HsSplice GhcPs
mkUntypedSplice :: SpliceDecoration -> LHsExpr GhcPs -> HsSplice GhcPs
mkUntypedSplice SpliceDecoration
hasParen LHsExpr GhcPs
e = XUntypedSplice GhcPs
-> SpliceDecoration -> IdP GhcPs -> LHsExpr GhcPs -> HsSplice GhcPs
forall id.
XUntypedSplice id
-> SpliceDecoration -> IdP id -> LHsExpr id -> HsSplice id
HsUntypedSplice XUntypedSplice GhcPs
NoExtField
noExtField SpliceDecoration
hasParen RdrName
IdP GhcPs
unqualSplice LHsExpr GhcPs
e

mkTypedSplice :: SpliceDecoration -> LHsExpr GhcPs -> HsSplice GhcPs
mkTypedSplice :: SpliceDecoration -> LHsExpr GhcPs -> HsSplice GhcPs
mkTypedSplice SpliceDecoration
hasParen LHsExpr GhcPs
e = XTypedSplice GhcPs
-> SpliceDecoration -> IdP GhcPs -> LHsExpr GhcPs -> HsSplice GhcPs
forall id.
XTypedSplice id
-> SpliceDecoration -> IdP id -> LHsExpr id -> HsSplice id
HsTypedSplice XTypedSplice GhcPs
NoExtField
noExtField SpliceDecoration
hasParen RdrName
IdP GhcPs
unqualSplice LHsExpr GhcPs
e

mkHsQuasiQuote :: RdrName -> SrcSpan -> FastString -> HsSplice GhcPs
mkHsQuasiQuote :: RdrName -> SrcSpan -> FastString -> HsSplice GhcPs
mkHsQuasiQuote RdrName
quoter SrcSpan
span FastString
quote
  = XQuasiQuote GhcPs
-> IdP GhcPs
-> IdP GhcPs
-> SrcSpan
-> FastString
-> HsSplice GhcPs
forall id.
XQuasiQuote id
-> IdP id -> IdP id -> SrcSpan -> FastString -> HsSplice id
HsQuasiQuote XQuasiQuote GhcPs
NoExtField
noExtField RdrName
IdP GhcPs
unqualSplice RdrName
IdP GhcPs
quoter SrcSpan
span FastString
quote

unqualQuasiQuote :: RdrName
unqualQuasiQuote :: RdrName
unqualQuasiQuote = OccName -> RdrName
mkRdrUnqual (FastString -> OccName
mkVarOccFS (String -> FastString
fsLit String
"quasiquote"))
                -- A name (uniquified later) to
                -- identify the quasi-quote

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

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


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

nlHsVar :: IdP (GhcPass id) -> LHsExpr (GhcPass id)
nlHsVar :: IdP (GhcPass id) -> LHsExpr (GhcPass id)
nlHsVar IdP (GhcPass id)
n = SrcSpanLess (LHsExpr (GhcPass id)) -> LHsExpr (GhcPass id)
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (XVar (GhcPass id)
-> Located (IdP (GhcPass id)) -> HsExpr (GhcPass id)
forall p. XVar p -> Located (IdP p) -> HsExpr p
HsVar XVar (GhcPass id)
NoExtField
noExtField (SrcSpanLess (Located (IdP (GhcPass id)))
-> Located (IdP (GhcPass id))
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc SrcSpanLess (Located (IdP (GhcPass id)))
IdP (GhcPass id)
n))

-- | NB: Only for LHsExpr **Id**
nlHsDataCon :: DataCon -> LHsExpr GhcTc
nlHsDataCon :: DataCon -> LHsExpr GhcTc
nlHsDataCon DataCon
con = SrcSpanLess (LHsExpr GhcTc) -> LHsExpr GhcTc
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (XConLikeOut GhcTc -> ConLike -> PostTcExpr
forall p. XConLikeOut p -> ConLike -> HsExpr p
HsConLikeOut XConLikeOut GhcTc
NoExtField
noExtField (DataCon -> ConLike
RealDataCon DataCon
con))

nlHsLit :: HsLit (GhcPass p) -> LHsExpr (GhcPass p)
nlHsLit :: HsLit (GhcPass p) -> LHsExpr (GhcPass p)
nlHsLit HsLit (GhcPass p)
n = SrcSpanLess (LHsExpr (GhcPass p)) -> LHsExpr (GhcPass p)
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (XLitE (GhcPass p) -> HsLit (GhcPass p) -> HsExpr (GhcPass p)
forall p. XLitE p -> HsLit p -> HsExpr p
HsLit XLitE (GhcPass p)
NoExtField
noExtField HsLit (GhcPass p)
n)

nlHsIntLit :: Integer -> LHsExpr (GhcPass p)
nlHsIntLit :: Integer -> LHsExpr (GhcPass p)
nlHsIntLit Integer
n = SrcSpanLess (LHsExpr (GhcPass p)) -> LHsExpr (GhcPass p)
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (XLitE (GhcPass p) -> HsLit (GhcPass p) -> HsExpr (GhcPass p)
forall p. XLitE p -> HsLit p -> HsExpr p
HsLit XLitE (GhcPass p)
NoExtField
noExtField (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 :: IdP (GhcPass id) -> LPat (GhcPass id)
nlVarPat :: IdP (GhcPass id) -> LPat (GhcPass id)
nlVarPat IdP (GhcPass id)
n = SrcSpanLess (Located (Pat (GhcPass id)))
-> Located (Pat (GhcPass id))
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (XVarPat (GhcPass id)
-> Located (IdP (GhcPass id)) -> Pat (GhcPass id)
forall p. XVarPat p -> Located (IdP p) -> Pat p
VarPat XVarPat (GhcPass id)
NoExtField
noExtField (SrcSpanLess (Located (IdP (GhcPass id)))
-> Located (IdP (GhcPass id))
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc SrcSpanLess (Located (IdP (GhcPass id)))
IdP (GhcPass id)
n))

nlLitPat :: HsLit GhcPs -> LPat GhcPs
nlLitPat :: HsLit GhcPs -> LPat GhcPs
nlLitPat HsLit GhcPs
l = SrcSpanLess (Located (Pat GhcPs)) -> Located (Pat GhcPs)
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (XLitPat GhcPs -> HsLit GhcPs -> Pat GhcPs
forall p. XLitPat p -> HsLit p -> Pat p
LitPat XLitPat GhcPs
NoExtField
noExtField HsLit GhcPs
l)

nlHsApp :: LHsExpr (GhcPass id) -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
nlHsApp :: LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
nlHsApp LHsExpr (GhcPass id)
f LHsExpr (GhcPass id)
x = SrcSpanLess (LHsExpr (GhcPass id)) -> LHsExpr (GhcPass id)
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (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)
NoExtField
noExtField LHsExpr (GhcPass id)
f (LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
forall (id :: Pass). LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
mkLHsPar LHsExpr (GhcPass id)
x))

nlHsSyntaxApps :: SyntaxExpr (GhcPass id) -> [LHsExpr (GhcPass id)]
               -> LHsExpr (GhcPass id)
nlHsSyntaxApps :: SyntaxExpr (GhcPass id)
-> [LHsExpr (GhcPass id)] -> LHsExpr (GhcPass id)
nlHsSyntaxApps (SyntaxExpr { syn_expr :: forall p. SyntaxExpr p -> HsExpr p
syn_expr      = HsExpr (GhcPass id)
fun
                           , syn_arg_wraps :: forall p. SyntaxExpr p -> [HsWrapper]
syn_arg_wraps = [HsWrapper]
arg_wraps
                           , syn_res_wrap :: forall p. SyntaxExpr p -> HsWrapper
syn_res_wrap  = HsWrapper
res_wrap }) [LHsExpr (GhcPass id)]
args
  | [] <- [HsWrapper]
arg_wraps   -- in the noSyntaxExpr case
  = ASSERT( isIdHsWrapper res_wrap )
    (LHsExpr (GhcPass id)
 -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id))
-> LHsExpr (GhcPass id)
-> [LHsExpr (GhcPass id)]
-> LHsExpr (GhcPass id)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
forall (id :: Pass).
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
nlHsApp (SrcSpanLess (LHsExpr (GhcPass id)) -> LHsExpr (GhcPass id)
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc SrcSpanLess (LHsExpr (GhcPass id))
HsExpr (GhcPass id)
fun) [LHsExpr (GhcPass id)]
args

  | Bool
otherwise
  = HsWrapper -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
forall (id :: Pass).
HsWrapper -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
mkLHsWrap HsWrapper
res_wrap ((LHsExpr (GhcPass id)
 -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id))
-> LHsExpr (GhcPass id)
-> [LHsExpr (GhcPass id)]
-> LHsExpr (GhcPass id)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
forall (id :: Pass).
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
nlHsApp (SrcSpanLess (LHsExpr (GhcPass id)) -> LHsExpr (GhcPass id)
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc SrcSpanLess (LHsExpr (GhcPass id))
HsExpr (GhcPass id)
fun) (String
-> (HsWrapper -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id))
-> [HsWrapper]
-> [LHsExpr (GhcPass id)]
-> [LHsExpr (GhcPass id)]
forall a b c. String -> (a -> b -> c) -> [a] -> [b] -> [c]
zipWithEqual String
"nlHsSyntaxApps"
                                                     HsWrapper -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
forall (id :: Pass).
HsWrapper -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
mkLHsWrap [HsWrapper]
arg_wraps [LHsExpr (GhcPass id)]
args))

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

nlHsVarApps :: IdP (GhcPass id) -> [IdP (GhcPass id)] -> LHsExpr (GhcPass id)
nlHsVarApps :: IdP (GhcPass id) -> [IdP (GhcPass id)] -> LHsExpr (GhcPass id)
nlHsVarApps IdP (GhcPass id)
f [IdP (GhcPass id)]
xs = SrcSpanLess (LHsExpr (GhcPass id)) -> LHsExpr (GhcPass id)
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc ((HsExpr (GhcPass id) -> HsExpr (GhcPass id) -> HsExpr (GhcPass id))
-> HsExpr (GhcPass id)
-> [HsExpr (GhcPass id)]
-> HsExpr (GhcPass id)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' HsExpr (GhcPass id) -> HsExpr (GhcPass id) -> HsExpr (GhcPass id)
forall p. (XApp p ~ NoExtField) => HsExpr p -> HsExpr p -> HsExpr p
mk (XVar (GhcPass id)
-> Located (IdP (GhcPass id)) -> HsExpr (GhcPass id)
forall p. XVar p -> Located (IdP p) -> HsExpr p
HsVar XVar (GhcPass id)
NoExtField
noExtField (SrcSpanLess (Located (IdP (GhcPass id)))
-> Located (IdP (GhcPass id))
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc SrcSpanLess (Located (IdP (GhcPass id)))
IdP (GhcPass id)
f))
                                               ((IdP (GhcPass id) -> HsExpr (GhcPass id))
-> [IdP (GhcPass id)] -> [HsExpr (GhcPass id)]
forall a b. (a -> b) -> [a] -> [b]
map ((XVar (GhcPass id)
-> Located (IdP (GhcPass id)) -> HsExpr (GhcPass id)
forall p. XVar p -> Located (IdP p) -> HsExpr p
HsVar XVar (GhcPass id)
NoExtField
noExtField) (Located (IdP (GhcPass id)) -> HsExpr (GhcPass id))
-> (IdP (GhcPass id) -> Located (IdP (GhcPass id)))
-> IdP (GhcPass id)
-> HsExpr (GhcPass id)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdP (GhcPass id) -> Located (IdP (GhcPass id))
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc) [IdP (GhcPass id)]
xs))
                 where
                   mk :: HsExpr p -> HsExpr p -> HsExpr p
mk HsExpr p
f HsExpr p
a = XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
HsApp XApp p
NoExtField
noExtField (SrcSpanLess (LHsExpr p) -> LHsExpr p
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc SrcSpanLess (LHsExpr p)
HsExpr p
f) (SrcSpanLess (LHsExpr p) -> LHsExpr p
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc SrcSpanLess (LHsExpr p)
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 -> Located (Pat GhcPs))
-> [RdrName] -> [Located (Pat GhcPs)]
forall a b. (a -> b) -> [a] -> [b]
map RdrName -> Located (Pat GhcPs)
forall (id :: Pass). IdP (GhcPass id) -> LPat (GhcPass id)
nlVarPat [RdrName]
vars)

nlConVarPatName :: Name -> [Name] -> LPat GhcRn
nlConVarPatName :: Name -> [Name] -> LPat GhcRn
nlConVarPatName Name
con [Name]
vars = Name -> [LPat GhcRn] -> LPat GhcRn
nlConPatName Name
con ((Name -> Located (Pat GhcRn)) -> [Name] -> [Located (Pat GhcRn)]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Located (Pat GhcRn)
forall (id :: Pass). IdP (GhcPass id) -> LPat (GhcPass id)
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 = SrcSpanLess (Located (Pat GhcPs)) -> Located (Pat GhcPs)
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (Located (IdP GhcPs) -> HsConPatDetails GhcPs -> Pat GhcPs
forall p. Located (IdP p) -> HsConPatDetails p -> Pat p
ConPatIn (SrcSpanLess (Located RdrName) -> Located RdrName
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc SrcSpanLess (Located RdrName)
RdrName
con)
                              (Located (Pat GhcPs)
-> Located (Pat GhcPs)
-> HsConDetails
     (Located (Pat GhcPs)) (HsRecFields GhcPs (Located (Pat GhcPs)))
forall arg rec. arg -> arg -> HsConDetails arg rec
InfixCon (PprPrec -> LPat GhcPs -> LPat GhcPs
forall (p :: Pass). PprPrec -> LPat (GhcPass p) -> LPat (GhcPass p)
parenthesizePat PprPrec
opPrec LPat GhcPs
l)
                                        (PprPrec -> LPat GhcPs -> LPat GhcPs
forall (p :: Pass). PprPrec -> LPat (GhcPass p) -> LPat (GhcPass p)
parenthesizePat PprPrec
opPrec LPat GhcPs
r)))

nlConPat :: RdrName -> [LPat GhcPs] -> LPat GhcPs
nlConPat :: RdrName -> [LPat GhcPs] -> LPat GhcPs
nlConPat RdrName
con [LPat GhcPs]
pats =
  SrcSpanLess (Located (Pat GhcPs)) -> Located (Pat GhcPs)
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (Located (IdP GhcPs) -> HsConPatDetails GhcPs -> Pat GhcPs
forall p. Located (IdP p) -> HsConPatDetails p -> Pat p
ConPatIn (SrcSpanLess (Located RdrName) -> Located RdrName
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc SrcSpanLess (Located RdrName)
RdrName
con) ([Located (Pat GhcPs)]
-> HsConDetails
     (Located (Pat GhcPs)) (HsRecFields GhcPs (Located (Pat GhcPs)))
forall arg rec. [arg] -> HsConDetails arg rec
PrefixCon ((Located (Pat GhcPs) -> Located (Pat GhcPs))
-> [Located (Pat GhcPs)] -> [Located (Pat GhcPs)]
forall a b. (a -> b) -> [a] -> [b]
map (PprPrec -> LPat GhcPs -> LPat GhcPs
forall (p :: Pass). PprPrec -> LPat (GhcPass p) -> LPat (GhcPass p)
parenthesizePat PprPrec
appPrec) [Located (Pat GhcPs)]
[LPat GhcPs]
pats)))

nlConPatName :: Name -> [LPat GhcRn] -> LPat GhcRn
nlConPatName :: Name -> [LPat GhcRn] -> LPat GhcRn
nlConPatName Name
con [LPat GhcRn]
pats =
  SrcSpanLess (Located (Pat GhcRn)) -> Located (Pat GhcRn)
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (Located (IdP GhcRn) -> HsConPatDetails GhcRn -> Pat GhcRn
forall p. Located (IdP p) -> HsConPatDetails p -> Pat p
ConPatIn (SrcSpanLess (Located Name) -> Located Name
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc Name
SrcSpanLess (Located Name)
con) ([Located (Pat GhcRn)]
-> HsConDetails
     (Located (Pat GhcRn)) (HsRecFields GhcRn (Located (Pat GhcRn)))
forall arg rec. [arg] -> HsConDetails arg rec
PrefixCon ((Located (Pat GhcRn) -> Located (Pat GhcRn))
-> [Located (Pat GhcRn)] -> [Located (Pat GhcRn)]
forall a b. (a -> b) -> [a] -> [b]
map (PprPrec -> LPat GhcRn -> LPat GhcRn
forall (p :: Pass). PprPrec -> LPat (GhcPass p) -> LPat (GhcPass p)
parenthesizePat PprPrec
appPrec) [Located (Pat GhcRn)]
[LPat GhcRn]
pats)))

nlNullaryConPat :: IdP (GhcPass p) -> LPat (GhcPass p)
nlNullaryConPat :: IdP (GhcPass p) -> LPat (GhcPass p)
nlNullaryConPat IdP (GhcPass p)
con = SrcSpanLess (Located (Pat (GhcPass p)))
-> Located (Pat (GhcPass p))
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (Located (IdP (GhcPass p))
-> HsConPatDetails (GhcPass p) -> Pat (GhcPass p)
forall p. Located (IdP p) -> HsConPatDetails p -> Pat p
ConPatIn (SrcSpanLess (Located (IdP (GhcPass p)))
-> Located (IdP (GhcPass p))
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc SrcSpanLess (Located (IdP (GhcPass p)))
IdP (GhcPass p)
con) ([Located (Pat (GhcPass p))]
-> HsConDetails
     (Located (Pat (GhcPass p)))
     (HsRecFields (GhcPass p) (Located (Pat (GhcPass p))))
forall arg rec. [arg] -> HsConDetails arg rec
PrefixCon []))

nlWildConPat :: DataCon -> LPat GhcPs
nlWildConPat :: DataCon -> LPat GhcPs
nlWildConPat DataCon
con = SrcSpanLess (Located (Pat GhcPs)) -> Located (Pat GhcPs)
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (Located (IdP GhcPs) -> HsConPatDetails GhcPs -> Pat GhcPs
forall p. Located (IdP p) -> HsConPatDetails p -> Pat p
ConPatIn (SrcSpanLess (Located RdrName) -> Located RdrName
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (DataCon -> RdrName
forall thing. NamedThing thing => thing -> RdrName
getRdrName DataCon
con))
                         ([Located (Pat GhcPs)]
-> HsConDetails
     (Located (Pat GhcPs)) (HsRecFields GhcPs (Located (Pat GhcPs)))
forall arg rec. [arg] -> HsConDetails arg rec
PrefixCon (Int -> Located (Pat GhcPs) -> [Located (Pat GhcPs)]
forall a. Int -> a -> [a]
replicate (DataCon -> Int
dataConSourceArity DataCon
con)
                                             Located (Pat GhcPs)
LPat GhcPs
nlWildPat)))

-- | Wildcard pattern - after parsing
nlWildPat :: LPat GhcPs
nlWildPat :: LPat GhcPs
nlWildPat  = SrcSpanLess (Located (Pat GhcPs)) -> Located (Pat GhcPs)
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (XWildPat GhcPs -> Pat GhcPs
forall p. XWildPat p -> Pat p
WildPat XWildPat GhcPs
NoExtField
noExtField )

-- | Wildcard pattern - after renaming
nlWildPatName :: LPat GhcRn
nlWildPatName :: LPat GhcRn
nlWildPatName  = SrcSpanLess (Located (Pat GhcRn)) -> Located (Pat GhcRn)
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (XWildPat GhcRn -> Pat GhcRn
forall p. XWildPat p -> Pat p
WildPat XWildPat GhcRn
NoExtField
noExtField )

nlHsDo :: HsStmtContext Name -> [LStmt GhcPs (LHsExpr GhcPs)]
       -> LHsExpr GhcPs
nlHsDo :: HsStmtContext Name -> [ExprLStmt GhcPs] -> LHsExpr GhcPs
nlHsDo HsStmtContext Name
ctxt [ExprLStmt GhcPs]
stmts = SrcSpanLess (LHsExpr GhcPs) -> LHsExpr GhcPs
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (HsStmtContext Name -> [ExprLStmt GhcPs] -> HsExpr GhcPs
mkHsDo HsStmtContext Name
ctxt [ExprLStmt 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 = SrcSpanLess (LHsExpr GhcPs) -> LHsExpr GhcPs
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (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)
nlHsIf   :: LHsExpr (GhcPass id) -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
         -> LHsExpr (GhcPass id)
nlHsCase :: LHsExpr GhcPs -> [LMatch GhcPs (LHsExpr GhcPs)]
         -> LHsExpr GhcPs
nlList   :: [LHsExpr GhcPs] -> LHsExpr GhcPs

nlHsLam :: LMatch GhcPs (LHsExpr GhcPs) -> LHsExpr GhcPs
nlHsLam LMatch GhcPs (LHsExpr GhcPs)
match          = SrcSpanLess (LHsExpr GhcPs) -> LHsExpr GhcPs
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (XLam GhcPs -> MatchGroup GhcPs (LHsExpr GhcPs) -> HsExpr GhcPs
forall p. XLam p -> MatchGroup p (LHsExpr p) -> HsExpr p
HsLam XLam GhcPs
NoExtField
noExtField (Origin
-> [LMatch GhcPs (LHsExpr GhcPs)]
-> MatchGroup GhcPs (LHsExpr GhcPs)
forall name (body :: * -> *).
(XMG name (Located (body name)) ~ NoExtField) =>
Origin
-> [LMatch name (Located (body name))]
-> MatchGroup name (Located (body name))
mkMatchGroup Origin
Generated [LMatch GhcPs (LHsExpr GhcPs)
match]))
nlHsPar :: LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
nlHsPar LHsExpr (GhcPass id)
e              = SrcSpanLess (LHsExpr (GhcPass id)) -> LHsExpr (GhcPass id)
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (XPar (GhcPass id) -> LHsExpr (GhcPass id) -> HsExpr (GhcPass id)
forall p. XPar p -> LHsExpr p -> HsExpr p
HsPar XPar (GhcPass id)
NoExtField
noExtField LHsExpr (GhcPass id)
e)

-- | Note [Rebindable nlHsIf]
-- nlHsIf should generate if-expressions which are NOT subject to
-- RebindableSyntax, so the first field of HsIf is Nothing. (#12080)
nlHsIf :: LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id)
nlHsIf LHsExpr (GhcPass id)
cond LHsExpr (GhcPass id)
true LHsExpr (GhcPass id)
false = SrcSpanLess (LHsExpr (GhcPass id)) -> LHsExpr (GhcPass id)
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (XIf (GhcPass id)
-> Maybe (SyntaxExpr (GhcPass id))
-> LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id)
-> HsExpr (GhcPass id)
forall p.
XIf p
-> Maybe (SyntaxExpr p)
-> LHsExpr p
-> LHsExpr p
-> LHsExpr p
-> HsExpr p
HsIf XIf (GhcPass id)
NoExtField
noExtField Maybe (SyntaxExpr (GhcPass id))
forall a. Maybe a
Nothing LHsExpr (GhcPass id)
cond LHsExpr (GhcPass id)
true LHsExpr (GhcPass id)
false)

nlHsCase :: LHsExpr GhcPs -> [LMatch GhcPs (LHsExpr GhcPs)] -> LHsExpr GhcPs
nlHsCase LHsExpr GhcPs
expr [LMatch GhcPs (LHsExpr GhcPs)]
matches
  = SrcSpanLess (LHsExpr GhcPs) -> LHsExpr GhcPs
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (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
NoExtField
noExtField LHsExpr GhcPs
expr (Origin
-> [LMatch GhcPs (LHsExpr GhcPs)]
-> MatchGroup GhcPs (LHsExpr GhcPs)
forall name (body :: * -> *).
(XMG name (Located (body name)) ~ NoExtField) =>
Origin
-> [LMatch name (Located (body name))]
-> MatchGroup name (Located (body name))
mkMatchGroup Origin
Generated [LMatch GhcPs (LHsExpr GhcPs)]
matches))
nlList :: [LHsExpr GhcPs] -> LHsExpr GhcPs
nlList [LHsExpr GhcPs]
exprs          = SrcSpanLess (LHsExpr GhcPs) -> LHsExpr GhcPs
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (XExplicitList GhcPs
-> Maybe (SyntaxExpr GhcPs) -> [LHsExpr GhcPs] -> HsExpr GhcPs
forall p.
XExplicitList p -> Maybe (SyntaxExpr p) -> [LHsExpr p] -> HsExpr p
ExplicitList XExplicitList GhcPs
NoExtField
noExtField Maybe (SyntaxExpr GhcPs)
forall a. Maybe a
Nothing [LHsExpr GhcPs]
exprs)

nlHsAppTy :: LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)
nlHsTyVar :: IdP (GhcPass p)                            -> LHsType (GhcPass p)
nlHsFunTy :: LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)
nlHsParTy :: LHsType (GhcPass p)                        -> LHsType (GhcPass p)

nlHsAppTy :: LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)
nlHsAppTy LHsType (GhcPass p)
f LHsType (GhcPass p)
t = SrcSpanLess (LHsType (GhcPass p)) -> LHsType (GhcPass p)
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (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 :: IdP (GhcPass p) -> LHsType (GhcPass p)
nlHsTyVar IdP (GhcPass p)
x   = SrcSpanLess (LHsType (GhcPass p)) -> LHsType (GhcPass p)
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (XTyVar (GhcPass p)
-> PromotionFlag -> Located (IdP (GhcPass p)) -> HsType (GhcPass p)
forall pass.
XTyVar pass -> PromotionFlag -> Located (IdP pass) -> HsType pass
HsTyVar XTyVar (GhcPass p)
NoExtField
noExtField PromotionFlag
NotPromoted (SrcSpanLess (Located (IdP (GhcPass p)))
-> Located (IdP (GhcPass p))
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc SrcSpanLess (Located (IdP (GhcPass p)))
IdP (GhcPass p)
x))
nlHsFunTy :: LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)
nlHsFunTy LHsType (GhcPass p)
a LHsType (GhcPass p)
b = SrcSpanLess (LHsType (GhcPass p)) -> LHsType (GhcPass p)
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (XFunTy (GhcPass p)
-> LHsType (GhcPass p) -> LHsType (GhcPass p) -> HsType (GhcPass p)
forall pass.
XFunTy pass -> LHsType pass -> LHsType pass -> HsType pass
HsFunTy XFunTy (GhcPass p)
NoExtField
noExtField (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 :: LHsType (GhcPass p) -> LHsType (GhcPass p)
nlHsParTy LHsType (GhcPass p)
t   = SrcSpanLess (LHsType (GhcPass p)) -> LHsType (GhcPass p)
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (XParTy (GhcPass p) -> LHsType (GhcPass p) -> HsType (GhcPass p)
forall pass. XParTy pass -> LHsType pass -> HsType pass
HsParTy XParTy (GhcPass p)
NoExtField
noExtField LHsType (GhcPass p)
t)

nlHsTyConApp :: IdP (GhcPass p) -> [LHsType (GhcPass p)] -> LHsType (GhcPass p)
nlHsTyConApp :: IdP (GhcPass p) -> [LHsType (GhcPass p)] -> LHsType (GhcPass p)
nlHsTyConApp IdP (GhcPass p)
tycon [LHsType (GhcPass p)]
tys  = (LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p))
-> LHsType (GhcPass p)
-> [LHsType (GhcPass p)]
-> LHsType (GhcPass p)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)
forall (p :: Pass).
LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)
nlHsAppTy (IdP (GhcPass p) -> LHsType (GhcPass p)
forall (p :: Pass). IdP (GhcPass p) -> LHsType (GhcPass p)
nlHsTyVar IdP (GhcPass p)
tycon) [LHsType (GhcPass p)]
tys

nlHsAppKindTy ::
  LHsType (GhcPass p) -> LHsKind (GhcPass p) -> LHsType (GhcPass p)
nlHsAppKindTy :: LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)
nlHsAppKindTy LHsType (GhcPass p)
f LHsType (GhcPass p)
k
  = SrcSpanLess (LHsType (GhcPass p)) -> LHsType (GhcPass p)
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (XAppKindTy (GhcPass p)
-> LHsType (GhcPass p) -> LHsType (GhcPass p) -> HsType (GhcPass p)
forall pass.
XAppKindTy pass -> LHsType pass -> LHsType pass -> HsType pass
HsAppKindTy SrcSpan
XAppKindTy (GhcPass p)
noSrcSpan 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)
k))

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

mkLHsTupleExpr :: [LHsExpr (GhcPass a)] -> LHsExpr (GhcPass a)
-- Makes a pre-typechecker boxed tuple, deals with 1 case
mkLHsTupleExpr :: [LHsExpr (GhcPass a)] -> LHsExpr (GhcPass a)
mkLHsTupleExpr [LHsExpr (GhcPass a)
e] = LHsExpr (GhcPass a)
e
mkLHsTupleExpr [LHsExpr (GhcPass a)]
es
  = SrcSpanLess (LHsExpr (GhcPass a)) -> LHsExpr (GhcPass a)
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (SrcSpanLess (LHsExpr (GhcPass a)) -> LHsExpr (GhcPass a))
-> SrcSpanLess (LHsExpr (GhcPass a)) -> LHsExpr (GhcPass a)
forall a b. (a -> b) -> a -> b
$ XExplicitTuple (GhcPass a)
-> [LHsTupArg (GhcPass a)] -> Boxity -> HsExpr (GhcPass a)
forall p. XExplicitTuple p -> [LHsTupArg p] -> Boxity -> HsExpr p
ExplicitTuple XExplicitTuple (GhcPass a)
NoExtField
noExtField ((LHsExpr (GhcPass a) -> LHsTupArg (GhcPass a))
-> [LHsExpr (GhcPass a)] -> [LHsTupArg (GhcPass a)]
forall a b. (a -> b) -> [a] -> [b]
map (HsTupArg (GhcPass a) -> LHsTupArg (GhcPass a)
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (HsTupArg (GhcPass a) -> LHsTupArg (GhcPass a))
-> (LHsExpr (GhcPass a) -> HsTupArg (GhcPass a))
-> LHsExpr (GhcPass a)
-> LHsTupArg (GhcPass a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (XPresent (GhcPass a) -> LHsExpr (GhcPass a) -> HsTupArg (GhcPass a)
forall id. XPresent id -> LHsExpr id -> HsTupArg id
Present XPresent (GhcPass a)
NoExtField
noExtField)) [LHsExpr (GhcPass a)]
es) Boxity
Boxed

mkLHsVarTuple :: [IdP (GhcPass a)] -> LHsExpr (GhcPass a)
mkLHsVarTuple :: [IdP (GhcPass a)] -> LHsExpr (GhcPass a)
mkLHsVarTuple [IdP (GhcPass a)]
ids  = [LHsExpr (GhcPass a)] -> LHsExpr (GhcPass a)
forall (a :: Pass). [LHsExpr (GhcPass a)] -> LHsExpr (GhcPass a)
mkLHsTupleExpr ((IdP (GhcPass a) -> LHsExpr (GhcPass a))
-> [IdP (GhcPass a)] -> [LHsExpr (GhcPass a)]
forall a b. (a -> b) -> [a] -> [b]
map IdP (GhcPass a) -> LHsExpr (GhcPass a)
forall (id :: Pass). IdP (GhcPass id) -> LHsExpr (GhcPass id)
nlHsVar [IdP (GhcPass a)]
ids)

nlTuplePat :: [LPat GhcPs] -> Boxity -> LPat GhcPs
nlTuplePat :: [LPat GhcPs] -> Boxity -> LPat GhcPs
nlTuplePat [LPat GhcPs]
pats Boxity
box = SrcSpanLess (Located (Pat GhcPs)) -> Located (Pat GhcPs)
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (XTuplePat GhcPs -> [LPat GhcPs] -> Boxity -> Pat GhcPs
forall p. XTuplePat p -> [LPat p] -> Boxity -> Pat p
TuplePat XTuplePat GhcPs
NoExtField
noExtField [LPat GhcPs]
pats Boxity
box)

missingTupArg :: HsTupArg GhcPs
missingTupArg :: HsTupArg GhcPs
missingTupArg = XMissing GhcPs -> HsTupArg GhcPs
forall id. XMissing id -> HsTupArg id
Missing XMissing GhcPs
NoExtField
noExtField

mkLHsPatTup :: [LPat GhcRn] -> LPat GhcRn
mkLHsPatTup :: [LPat GhcRn] -> LPat GhcRn
mkLHsPatTup []     = SrcSpanLess (Located (Pat GhcRn)) -> Located (Pat GhcRn)
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (SrcSpanLess (Located (Pat GhcRn)) -> Located (Pat GhcRn))
-> SrcSpanLess (Located (Pat GhcRn)) -> Located (Pat GhcRn)
forall a b. (a -> b) -> a -> b
$ XTuplePat GhcRn -> [LPat GhcRn] -> Boxity -> Pat GhcRn
forall p. XTuplePat p -> [LPat p] -> Boxity -> Pat p
TuplePat XTuplePat GhcRn
NoExtField
noExtField [] Boxity
Boxed
mkLHsPatTup [LPat GhcRn
lpat] = LPat GhcRn
lpat
mkLHsPatTup [LPat GhcRn]
lpats  = SrcSpan -> SrcSpanLess (Located (Pat GhcRn)) -> Located (Pat GhcRn)
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL (Located (Pat GhcRn) -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc ([Located (Pat GhcRn)] -> Located (Pat GhcRn)
forall a. [a] -> a
head [Located (Pat GhcRn)]
[LPat GhcRn]
lpats)) (SrcSpanLess (Located (Pat GhcRn)) -> Located (Pat GhcRn))
-> SrcSpanLess (Located (Pat GhcRn)) -> Located (Pat GhcRn)
forall a b. (a -> b) -> a -> b
$ XTuplePat GhcRn -> [LPat GhcRn] -> Boxity -> Pat GhcRn
forall p. XTuplePat p -> [LPat p] -> Boxity -> Pat p
TuplePat XTuplePat GhcRn
NoExtField
noExtField [LPat GhcRn]
lpats Boxity
Boxed

-- | The Big equivalents for the source tuple expressions
mkBigLHsVarTup :: [IdP (GhcPass id)] -> LHsExpr (GhcPass id)
mkBigLHsVarTup :: [IdP (GhcPass id)] -> LHsExpr (GhcPass id)
mkBigLHsVarTup [IdP (GhcPass id)]
ids = [LHsExpr (GhcPass id)] -> LHsExpr (GhcPass id)
forall (a :: Pass). [LHsExpr (GhcPass a)] -> LHsExpr (GhcPass a)
mkBigLHsTup ((IdP (GhcPass id) -> LHsExpr (GhcPass id))
-> [IdP (GhcPass id)] -> [LHsExpr (GhcPass id)]
forall a b. (a -> b) -> [a] -> [b]
map IdP (GhcPass id) -> LHsExpr (GhcPass id)
forall (id :: Pass). IdP (GhcPass id) -> LHsExpr (GhcPass id)
nlHsVar [IdP (GhcPass id)]
ids)

mkBigLHsTup :: [LHsExpr (GhcPass id)] -> LHsExpr (GhcPass id)
mkBigLHsTup :: [LHsExpr (GhcPass id)] -> LHsExpr (GhcPass id)
mkBigLHsTup = ([LHsExpr (GhcPass id)] -> LHsExpr (GhcPass id))
-> [LHsExpr (GhcPass id)] -> LHsExpr (GhcPass id)
forall a. ([a] -> a) -> [a] -> a
mkChunkified [LHsExpr (GhcPass id)] -> LHsExpr (GhcPass id)
forall (a :: Pass). [LHsExpr (GhcPass a)] -> LHsExpr (GhcPass a)
mkLHsTupleExpr

-- | The Big equivalents for the source tuple patterns
mkBigLHsVarPatTup :: [IdP GhcRn] -> LPat GhcRn
mkBigLHsVarPatTup :: [IdP GhcRn] -> LPat GhcRn
mkBigLHsVarPatTup [IdP GhcRn]
bs = [LPat GhcRn] -> LPat GhcRn
mkBigLHsPatTup ((Name -> Located (Pat GhcRn)) -> [Name] -> [Located (Pat GhcRn)]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Located (Pat GhcRn)
forall (id :: Pass). IdP (GhcPass id) -> LPat (GhcPass id)
nlVarPat [Name]
[IdP GhcRn]
bs)

mkBigLHsPatTup :: [LPat GhcRn] -> LPat GhcRn
mkBigLHsPatTup :: [LPat GhcRn] -> LPat GhcRn
mkBigLHsPatTup = ([Located (Pat GhcRn)] -> Located (Pat GhcRn))
-> [Located (Pat GhcRn)] -> Located (Pat GhcRn)
forall a. ([a] -> a) -> [a] -> a
mkChunkified [Located (Pat GhcRn)] -> Located (Pat GhcRn)
[LPat GhcRn] -> LPat GhcRn
mkLHsPatTup

-- $big_tuples
-- #big_tuples#
--
-- GHCs built in tuples can only go up to 'mAX_TUPLE_SIZE' in arity, but
-- we might concievably want to build such a massive tuple as part of the
-- output of a desugaring stage (notably that for list comprehensions).
--
-- We call tuples above this size \"big tuples\", and emulate them by
-- creating and pattern matching on >nested< tuples that are expressible
-- by GHC.
--
-- Nesting policy: it's better to have a 2-tuple of 10-tuples (3 objects)
-- than a 10-tuple of 2-tuples (11 objects), so we want the leaves of any
-- construction to be big.
--
-- If you just use the 'mkBigCoreTup', 'mkBigCoreVarTupTy', 'mkTupleSelector'
-- and 'mkTupleCase' functions to do all your work with tuples you should be
-- fine, and not have to worry about the arity limitation at all.

-- | Lifts a \"small\" constructor into a \"big\" constructor by recursive decompositon
mkChunkified :: ([a] -> a)      -- ^ \"Small\" constructor function, of maximum input arity 'mAX_TUPLE_SIZE'
             -> [a]             -- ^ Possible \"big\" list of things to construct from
             -> a               -- ^ Constructed thing made possible by recursive decomposition
mkChunkified :: ([a] -> a) -> [a] -> a
mkChunkified [a] -> a
small_tuple [a]
as = [[a]] -> a
mk_big_tuple ([a] -> [[a]]
forall a. [a] -> [[a]]
chunkify [a]
as)
  where
        -- Each sub-list is short enough to fit in a tuple
    mk_big_tuple :: [[a]] -> a
mk_big_tuple [[a]
as] = [a] -> a
small_tuple [a]
as
    mk_big_tuple [[a]]
as_s = [[a]] -> a
mk_big_tuple ([a] -> [[a]]
forall a. [a] -> [[a]]
chunkify (([a] -> a) -> [[a]] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> a
small_tuple [[a]]
as_s))

chunkify :: [a] -> [[a]]
-- ^ Split a list into lists that are small enough to have a corresponding
-- tuple arity. The sub-lists of the result all have length <= 'mAX_TUPLE_SIZE'
-- But there may be more than 'mAX_TUPLE_SIZE' sub-lists
chunkify :: [a] -> [[a]]
chunkify [a]
xs
  | Int
n_xs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
mAX_TUPLE_SIZE = [[a]
xs]
  | Bool
otherwise              = [a] -> [[a]]
forall a. [a] -> [[a]]
split [a]
xs
  where
    n_xs :: Int
n_xs     = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs
    split :: [a] -> [[a]]
split [] = []
    split [a]
xs = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
mAX_TUPLE_SIZE [a]
xs [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [a] -> [[a]]
split (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
mAX_TUPLE_SIZE [a]
xs)

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

mkLHsSigType :: LHsType GhcPs -> LHsSigType GhcPs
mkLHsSigType :: LHsType GhcPs -> LHsSigType GhcPs
mkLHsSigType LHsType GhcPs
ty = LHsType GhcPs -> LHsSigType GhcPs
forall thing. thing -> HsImplicitBndrs GhcPs thing
mkHsImplicitBndrs LHsType GhcPs
ty

mkLHsSigWcType :: LHsType GhcPs -> LHsSigWcType GhcPs
mkLHsSigWcType :: LHsType GhcPs -> LHsSigWcType GhcPs
mkLHsSigWcType LHsType GhcPs
ty = LHsSigType GhcPs -> LHsSigWcType GhcPs
forall thing. thing -> HsWildCardBndrs GhcPs thing
mkHsWildCardBndrs (LHsType GhcPs -> LHsSigType GhcPs
forall thing. thing -> HsImplicitBndrs GhcPs thing
mkHsImplicitBndrs LHsType GhcPs
ty)

mkHsSigEnv :: forall a. (LSig GhcRn -> Maybe ([Located Name], a))
                     -> [LSig GhcRn]
                     -> NameEnv a
mkHsSigEnv :: (LSig GhcRn -> Maybe ([Located Name], a))
-> [LSig GhcRn] -> NameEnv a
mkHsSigEnv LSig GhcRn -> Maybe ([Located Name], a)
get_info [LSig GhcRn]
sigs
  = [(Name, a)] -> NameEnv a
forall a. [(Name, a)] -> NameEnv a
mkNameEnv          ([LSig GhcRn] -> [(Name, a)]
mk_pairs [LSig GhcRn]
ordinary_sigs)
   NameEnv a -> [(Name, a)] -> NameEnv a
forall a. NameEnv a -> [(Name, a)] -> NameEnv a
`extendNameEnvList` ([LSig GhcRn] -> [(Name, a)]
mk_pairs [LSig GhcRn]
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
    ([LSig GhcRn]
gen_dm_sigs, [LSig GhcRn]
ordinary_sigs) = (LSig GhcRn -> Bool)
-> [LSig GhcRn] -> ([LSig GhcRn], [LSig GhcRn])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition LSig GhcRn -> Bool
forall a pass.
(HasSrcSpan a, SrcSpanLess a ~ Sig pass) =>
a -> Bool
is_gen_dm_sig [LSig GhcRn]
sigs
    is_gen_dm_sig :: a -> Bool
is_gen_dm_sig (a -> Located (SrcSpanLess a)
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ (ClassOpSig _ True _ _)) = Bool
True
    is_gen_dm_sig a
_                                 = Bool
False

    mk_pairs :: [LSig GhcRn] -> [(Name, a)]
    mk_pairs :: [LSig GhcRn] -> [(Name, a)]
mk_pairs [LSig GhcRn]
sigs = [ (Name
SrcSpanLess (Located Name)
n,a
a) | Just ([Located Name]
ns,a
a) <- (LSig GhcRn -> Maybe ([Located Name], a))
-> [LSig GhcRn] -> [Maybe ([Located Name], a)]
forall a b. (a -> b) -> [a] -> [b]
map LSig GhcRn -> Maybe ([Located Name], a)
get_info [LSig GhcRn]
sigs
                            , (Located Name -> Located (SrcSpanLess (Located Name))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ SrcSpanLess (Located Name)
n) <- [Located 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
  = (LSig GhcPs -> LSig GhcPs) -> [LSig GhcPs] -> [LSig GhcPs]
forall a b. (a -> b) -> [a] -> [b]
map LSig GhcPs -> LSig GhcPs
forall p pass.
(HasSrcSpan p, SrcSpanLess p ~ Sig pass,
 XClassOpSig pass ~ NoExtField) =>
p -> p
fiddle [LSig GhcPs]
sigs
  where
    fiddle :: p -> p
fiddle (p -> Located (SrcSpanLess p)
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
loc (TypeSig _ nms ty))
      = SrcSpan -> SrcSpanLess p -> p
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
loc (XClassOpSig pass
-> Bool -> [Located (IdP pass)] -> LHsSigType pass -> Sig pass
forall pass.
XClassOpSig pass
-> Bool -> [Located (IdP pass)] -> LHsSigType pass -> Sig pass
ClassOpSig XClassOpSig pass
NoExtField
noExtField Bool
False [Located (IdP pass)]
nms (LHsSigWcType pass -> LHsSigType pass
forall pass. LHsSigWcType pass -> LHsSigType pass
dropWildCards LHsSigWcType pass
ty))
    fiddle p
sig = p
sig

typeToLHsType :: Type -> LHsType GhcPs
-- ^ Converting a Type to an HsType RdrName
-- This is needed to implement GeneralizedNewtypeDeriving.
--
-- Note that we use 'getRdrName' extensively, which
-- generates Exact RdrNames rather than strings.
typeToLHsType :: Type -> LHsType GhcPs
typeToLHsType Type
ty
  = Type -> LHsType GhcPs
go Type
ty
  where
    go :: Type -> LHsType GhcPs
    go :: Type -> LHsType GhcPs
go ty :: Type
ty@(FunTy { ft_af :: Type -> AnonArgFlag
ft_af = AnonArgFlag
af, ft_arg :: Type -> Type
ft_arg = Type
arg, ft_res :: Type -> Type
ft_res = Type
res })
      = case AnonArgFlag
af of
          AnonArgFlag
VisArg   -> LHsType GhcPs -> LHsType GhcPs -> LHsType GhcPs
forall (p :: Pass).
LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)
nlHsFunTy (Type -> LHsType GhcPs
go Type
arg) (Type -> LHsType GhcPs
go Type
res)
          AnonArgFlag
InvisArg | ([Type]
theta, Type
tau) <- Type -> ([Type], Type)
tcSplitPhiTy Type
ty
                   -> SrcSpanLess (LHsType GhcPs) -> LHsType GhcPs
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (HsQualTy :: forall pass.
XQualTy pass -> LHsContext pass -> LHsType pass -> HsType pass
HsQualTy { hst_ctxt :: LHsContext GhcPs
hst_ctxt = SrcSpanLess (LHsContext GhcPs) -> LHsContext GhcPs
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc ((Type -> LHsType GhcPs) -> [Type] -> [LHsType GhcPs]
forall a b. (a -> b) -> [a] -> [b]
map Type -> LHsType GhcPs
go [Type]
theta)
                                      , hst_xqual :: XQualTy GhcPs
hst_xqual = XQualTy GhcPs
NoExtField
noExtField
                                      , hst_body :: LHsType GhcPs
hst_body = Type -> LHsType GhcPs
go Type
tau })

    go ty :: Type
ty@(ForAllTy (Bndr TyVar
_ ArgFlag
argf) Type
_)
      | ([TyVar]
tvs, Type
tau) <- ArgFlag -> Type -> ([TyVar], Type)
tcSplitForAllTysSameVis ArgFlag
argf Type
ty
      = SrcSpanLess (LHsType GhcPs) -> LHsType GhcPs
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (HsForAllTy :: forall pass.
XForAllTy pass
-> ForallVisFlag
-> [LHsTyVarBndr pass]
-> LHsType pass
-> HsType pass
HsForAllTy { hst_fvf :: ForallVisFlag
hst_fvf = ArgFlag -> ForallVisFlag
argToForallVisFlag ArgFlag
argf
                          , hst_bndrs :: [LHsTyVarBndr GhcPs]
hst_bndrs = (TyVar -> LHsTyVarBndr GhcPs) -> [TyVar] -> [LHsTyVarBndr GhcPs]
forall a b. (a -> b) -> [a] -> [b]
map TyVar -> LHsTyVarBndr GhcPs
go_tv [TyVar]
tvs
                          , hst_xforall :: XForAllTy GhcPs
hst_xforall = XForAllTy GhcPs
NoExtField
noExtField
                          , hst_body :: LHsType GhcPs
hst_body = Type -> LHsType GhcPs
go Type
tau })
    go (TyVarTy TyVar
tv)         = IdP GhcPs -> LHsType GhcPs
forall (p :: Pass). IdP (GhcPass p) -> LHsType (GhcPass p)
nlHsTyVar (TyVar -> RdrName
forall thing. NamedThing thing => thing -> RdrName
getRdrName TyVar
tv)
    go (LitTy (NumTyLit Integer
n))
      = SrcSpanLess (LHsType GhcPs) -> LHsType GhcPs
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (SrcSpanLess (LHsType GhcPs) -> LHsType GhcPs)
-> SrcSpanLess (LHsType GhcPs) -> LHsType GhcPs
forall a b. (a -> b) -> a -> b
$ XTyLit GhcPs -> HsTyLit -> HsType GhcPs
forall pass. XTyLit pass -> HsTyLit -> HsType pass
HsTyLit XTyLit GhcPs
NoExtField
noExtField (SourceText -> Integer -> HsTyLit
HsNumTy SourceText
NoSourceText Integer
n)
    go (LitTy (StrTyLit FastString
s))
      = SrcSpanLess (LHsType GhcPs) -> LHsType GhcPs
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (SrcSpanLess (LHsType GhcPs) -> LHsType GhcPs)
-> SrcSpanLess (LHsType GhcPs) -> LHsType GhcPs
forall a b. (a -> b) -> a -> b
$ XTyLit GhcPs -> HsTyLit -> HsType GhcPs
forall pass. XTyLit pass -> HsTyLit -> HsType pass
HsTyLit XTyLit GhcPs
NoExtField
noExtField (SourceText -> FastString -> HsTyLit
HsStrTy SourceText
NoSourceText FastString
s)
    go ty :: Type
ty@(TyConApp TyCon
tc [Type]
args)
      | Bool -> TyCon -> Int -> Bool
tyConAppNeedsKindSig Bool
True TyCon
tc ([Type] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Type]
args)
        -- We must produce an explicit kind signature here to make certain
        -- programs kind-check. See Note [Kind signatures in typeToLHsType].
      = LHsType GhcPs -> LHsType GhcPs
forall (p :: Pass). LHsType (GhcPass p) -> LHsType (GhcPass p)
nlHsParTy (LHsType GhcPs -> LHsType GhcPs) -> LHsType GhcPs -> LHsType GhcPs
forall a b. (a -> b) -> a -> b
$ SrcSpanLess (LHsType GhcPs) -> LHsType GhcPs
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (SrcSpanLess (LHsType GhcPs) -> LHsType GhcPs)
-> SrcSpanLess (LHsType GhcPs) -> LHsType GhcPs
forall a b. (a -> b) -> a -> b
$ XKindSig GhcPs -> LHsType GhcPs -> LHsType GhcPs -> HsType GhcPs
forall pass.
XKindSig pass -> LHsType pass -> LHsType pass -> HsType pass
HsKindSig XKindSig GhcPs
NoExtField
noExtField LHsType GhcPs
ty' (Type -> LHsType GhcPs
go (HasDebugCallStack => Type -> Type
Type -> Type
tcTypeKind Type
ty))
      | Bool
otherwise = LHsType GhcPs
ty'
       where
        ty' :: LHsType GhcPs
        ty' :: LHsType GhcPs
ty' = LHsType GhcPs -> [Type] -> [ArgFlag] -> LHsType GhcPs
go_app (IdP GhcPs -> LHsType GhcPs
forall (p :: Pass). IdP (GhcPass p) -> LHsType (GhcPass p)
nlHsTyVar (TyCon -> RdrName
forall thing. NamedThing thing => thing -> RdrName
getRdrName TyCon
tc)) [Type]
args (TyCon -> [Type] -> [ArgFlag]
tyConArgFlags TyCon
tc [Type]
args)
    go ty :: Type
ty@(AppTy {})        = LHsType GhcPs -> [Type] -> [ArgFlag] -> LHsType GhcPs
go_app (Type -> LHsType GhcPs
go Type
head) [Type]
args (Type -> [Type] -> [ArgFlag]
appTyArgFlags Type
head [Type]
args)
      where
        head :: Type
        args :: [Type]
        (Type
head, [Type]
args) = Type -> (Type, [Type])
splitAppTys Type
ty
    go (CastTy Type
ty KindCoercion
_)        = Type -> LHsType GhcPs
go Type
ty
    go (CoercionTy KindCoercion
co)      = String -> SDoc -> LHsType GhcPs
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"toLHsSigWcType" (KindCoercion -> SDoc
forall a. Outputable a => a -> SDoc
ppr KindCoercion
co)

         -- Source-language types have _invisible_ kind arguments,
         -- so we must remove them here (#8563)

    go_app :: LHsType GhcPs -- The type being applied
           -> [Type]        -- The argument types
           -> [ArgFlag]     -- The argument types' visibilities
           -> LHsType GhcPs
    go_app :: LHsType GhcPs -> [Type] -> [ArgFlag] -> LHsType GhcPs
go_app LHsType GhcPs
head [Type]
args [ArgFlag]
arg_flags =
      (LHsType GhcPs -> (Type, ArgFlag) -> LHsType GhcPs)
-> LHsType GhcPs -> [(Type, ArgFlag)] -> LHsType GhcPs
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\LHsType GhcPs
f (Type
arg, ArgFlag
flag) ->
               let arg' :: LHsType GhcPs
arg' = Type -> LHsType GhcPs
go Type
arg in
               case ArgFlag
flag of
                 ArgFlag
Inferred  -> LHsType GhcPs
f
                 ArgFlag
Specified -> LHsType GhcPs
f LHsType GhcPs -> LHsType GhcPs -> LHsType GhcPs
forall (p :: Pass).
LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)
`nlHsAppKindTy` LHsType GhcPs
arg'
                 ArgFlag
Required  -> LHsType GhcPs
f LHsType GhcPs -> LHsType GhcPs -> LHsType GhcPs
forall (p :: Pass).
LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)
`nlHsAppTy`     LHsType GhcPs
arg')
             LHsType GhcPs
head ([Type] -> [ArgFlag] -> [(Type, ArgFlag)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Type]
args [ArgFlag]
arg_flags)

    go_tv :: TyVar -> LHsTyVarBndr GhcPs
    go_tv :: TyVar -> LHsTyVarBndr GhcPs
go_tv TyVar
tv = SrcSpanLess (LHsTyVarBndr GhcPs) -> LHsTyVarBndr GhcPs
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (SrcSpanLess (LHsTyVarBndr GhcPs) -> LHsTyVarBndr GhcPs)
-> SrcSpanLess (LHsTyVarBndr GhcPs) -> LHsTyVarBndr GhcPs
forall a b. (a -> b) -> a -> b
$ XKindedTyVar GhcPs
-> Located (IdP GhcPs) -> LHsType GhcPs -> HsTyVarBndr GhcPs
forall pass.
XKindedTyVar pass
-> Located (IdP pass) -> LHsKind pass -> HsTyVarBndr pass
KindedTyVar XKindedTyVar GhcPs
NoExtField
noExtField (SrcSpanLess (Located RdrName) -> Located RdrName
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (TyVar -> RdrName
forall thing. NamedThing thing => thing -> RdrName
getRdrName TyVar
tv))
                                   (Type -> LHsType GhcPs
go (TyVar -> Type
tyVarKind TyVar
tv))

{-
Note [Kind signatures in typeToLHsType]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
There are types that typeToLHsType can produce which require explicit kind
signatures in order to kind-check. Here is an example from #14579:

  -- type P :: forall {k} {t :: k}. Proxy t
  type P = 'Proxy

  -- type Wat :: forall a. Proxy a -> *
  newtype Wat (x :: Proxy (a :: Type)) = MkWat (Maybe a)
    deriving Eq

  -- type Wat2 :: forall {a}. Proxy a -> *
  type Wat2 = Wat

  -- type Glurp :: * -> *
  newtype Glurp a = MkGlurp (Wat2 (P :: Proxy a))
    deriving Eq

The derived Eq instance for Glurp (without any kind signatures) would be:

  instance Eq a => Eq (Glurp a) where
    (==) = coerce @(Wat2 P  -> Wat2 P  -> Bool)
                  @(Glurp a -> Glurp a -> Bool)
                  (==) :: Glurp a -> Glurp a -> Bool

(Where the visible type applications use types produced by typeToLHsType.)

The type P (in Wat2 P) has an underspecified kind, so we must ensure that
typeToLHsType ascribes it with its kind: Wat2 (P :: Proxy a). To accomplish
this, whenever we see an application of a tycon to some arguments, we use
the tyConAppNeedsKindSig function to determine if it requires an explicit kind
signature to resolve some ambiguity. (See Note
Note [When does a tycon application need an explicit kind signature?] for a
more detailed explanation of how this works.)

Note that we pass True to tyConAppNeedsKindSig since we are generated code with
visible kind applications, so even specified arguments count towards injective
positions in the kind of the tycon.
-}

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

mkLHsWrap :: HsWrapper -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
mkLHsWrap :: HsWrapper -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
mkLHsWrap HsWrapper
co_fn (LHsExpr (GhcPass id)
-> Located (SrcSpanLess (LHsExpr (GhcPass id)))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
loc SrcSpanLess (LHsExpr (GhcPass id))
e) = SrcSpan
-> SrcSpanLess (LHsExpr (GhcPass id)) -> LHsExpr (GhcPass id)
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
loc (HsWrapper -> HsExpr (GhcPass id) -> HsExpr (GhcPass id)
forall (id :: Pass).
HsWrapper -> HsExpr (GhcPass id) -> HsExpr (GhcPass id)
mkHsWrap HsWrapper
co_fn SrcSpanLess (LHsExpr (GhcPass id))
HsExpr (GhcPass id)
e)

-- | Avoid (HsWrap co (HsWrap co' _)).
-- See Note [Detecting forced eta expansion] in DsExpr
mkHsWrap :: HsWrapper -> HsExpr (GhcPass id) -> HsExpr (GhcPass id)
mkHsWrap :: HsWrapper -> HsExpr (GhcPass id) -> HsExpr (GhcPass id)
mkHsWrap HsWrapper
co_fn HsExpr (GhcPass id)
e | HsWrapper -> Bool
isIdHsWrapper HsWrapper
co_fn = HsExpr (GhcPass id)
e
mkHsWrap HsWrapper
co_fn (HsWrap XWrap (GhcPass id)
_ HsWrapper
co_fn' HsExpr (GhcPass id)
e)     = HsWrapper -> HsExpr (GhcPass id) -> HsExpr (GhcPass id)
forall (id :: Pass).
HsWrapper -> HsExpr (GhcPass id) -> HsExpr (GhcPass id)
mkHsWrap (HsWrapper
co_fn HsWrapper -> HsWrapper -> HsWrapper
<.> HsWrapper
co_fn') HsExpr (GhcPass id)
e
mkHsWrap HsWrapper
co_fn HsExpr (GhcPass id)
e                       = XWrap (GhcPass id)
-> HsWrapper -> HsExpr (GhcPass id) -> HsExpr (GhcPass id)
forall p. XWrap p -> HsWrapper -> HsExpr p -> HsExpr p
HsWrap XWrap (GhcPass id)
NoExtField
noExtField HsWrapper
co_fn HsExpr (GhcPass id)
e

mkHsWrapCo :: TcCoercionN   -- A Nominal coercion  a ~N b
           -> HsExpr (GhcPass id) -> HsExpr (GhcPass id)
mkHsWrapCo :: KindCoercion -> HsExpr (GhcPass id) -> HsExpr (GhcPass id)
mkHsWrapCo KindCoercion
co HsExpr (GhcPass id)
e = HsWrapper -> HsExpr (GhcPass id) -> HsExpr (GhcPass id)
forall (id :: Pass).
HsWrapper -> HsExpr (GhcPass id) -> HsExpr (GhcPass id)
mkHsWrap (KindCoercion -> HsWrapper
mkWpCastN KindCoercion
co) HsExpr (GhcPass id)
e

mkHsWrapCoR :: TcCoercionR   -- A Representational coercion  a ~R b
            -> HsExpr (GhcPass id) -> HsExpr (GhcPass id)
mkHsWrapCoR :: KindCoercion -> HsExpr (GhcPass id) -> HsExpr (GhcPass id)
mkHsWrapCoR KindCoercion
co HsExpr (GhcPass id)
e = HsWrapper -> HsExpr (GhcPass id) -> HsExpr (GhcPass id)
forall (id :: Pass).
HsWrapper -> HsExpr (GhcPass id) -> HsExpr (GhcPass id)
mkHsWrap (KindCoercion -> HsWrapper
mkWpCastR KindCoercion
co) HsExpr (GhcPass id)
e

mkLHsWrapCo :: TcCoercionN -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
mkLHsWrapCo :: KindCoercion -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
mkLHsWrapCo KindCoercion
co (LHsExpr (GhcPass id)
-> Located (SrcSpanLess (LHsExpr (GhcPass id)))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
loc SrcSpanLess (LHsExpr (GhcPass id))
e) = SrcSpan
-> SrcSpanLess (LHsExpr (GhcPass id)) -> LHsExpr (GhcPass id)
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
loc (KindCoercion -> HsExpr (GhcPass id) -> HsExpr (GhcPass id)
forall (id :: Pass).
KindCoercion -> HsExpr (GhcPass id) -> HsExpr (GhcPass id)
mkHsWrapCo KindCoercion
co SrcSpanLess (LHsExpr (GhcPass id))
HsExpr (GhcPass id)
e)

mkHsCmdWrap :: HsWrapper -> HsCmd (GhcPass p) -> HsCmd (GhcPass p)
mkHsCmdWrap :: HsWrapper -> HsCmd (GhcPass p) -> HsCmd (GhcPass p)
mkHsCmdWrap HsWrapper
w HsCmd (GhcPass p)
cmd | HsWrapper -> Bool
isIdHsWrapper HsWrapper
w = HsCmd (GhcPass p)
cmd
                  | Bool
otherwise       = XCmdWrap (GhcPass p)
-> HsWrapper -> HsCmd (GhcPass p) -> HsCmd (GhcPass p)
forall id. XCmdWrap id -> HsWrapper -> HsCmd id -> HsCmd id
HsCmdWrap XCmdWrap (GhcPass p)
NoExtField
noExtField HsWrapper
w HsCmd (GhcPass p)
cmd

mkLHsCmdWrap :: HsWrapper -> LHsCmd (GhcPass p) -> LHsCmd (GhcPass p)
mkLHsCmdWrap :: HsWrapper -> LHsCmd (GhcPass p) -> LHsCmd (GhcPass p)
mkLHsCmdWrap HsWrapper
w (LHsCmd (GhcPass p) -> Located (SrcSpanLess (LHsCmd (GhcPass p)))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
loc SrcSpanLess (LHsCmd (GhcPass p))
c) = SrcSpan -> SrcSpanLess (LHsCmd (GhcPass p)) -> LHsCmd (GhcPass p)
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
loc (HsWrapper -> HsCmd (GhcPass p) -> HsCmd (GhcPass p)
forall (p :: Pass).
HsWrapper -> HsCmd (GhcPass p) -> HsCmd (GhcPass p)
mkHsCmdWrap HsWrapper
w SrcSpanLess (LHsCmd (GhcPass p))
HsCmd (GhcPass p)
c)

mkHsWrapPat :: HsWrapper -> Pat (GhcPass id) -> Type -> Pat (GhcPass id)
mkHsWrapPat :: HsWrapper -> Pat (GhcPass id) -> Type -> Pat (GhcPass id)
mkHsWrapPat HsWrapper
co_fn Pat (GhcPass id)
p Type
ty | HsWrapper -> Bool
isIdHsWrapper HsWrapper
co_fn = Pat (GhcPass id)
p
                       | Bool
otherwise           = XCoPat (GhcPass id)
-> HsWrapper -> Pat (GhcPass id) -> Type -> Pat (GhcPass id)
forall p. XCoPat p -> HsWrapper -> Pat p -> Type -> Pat p
CoPat XCoPat (GhcPass id)
NoExtField
noExtField HsWrapper
co_fn Pat (GhcPass id)
p Type
ty

mkHsWrapPatCo :: TcCoercionN -> Pat (GhcPass id) -> Type -> Pat (GhcPass id)
mkHsWrapPatCo :: KindCoercion -> Pat (GhcPass id) -> Type -> Pat (GhcPass id)
mkHsWrapPatCo KindCoercion
co Pat (GhcPass id)
pat Type
ty | KindCoercion -> Bool
isTcReflCo KindCoercion
co = Pat (GhcPass id)
pat
                        | Bool
otherwise    = XCoPat (GhcPass id)
-> HsWrapper -> Pat (GhcPass id) -> Type -> Pat (GhcPass id)
forall p. XCoPat p -> HsWrapper -> Pat p -> Type -> Pat p
CoPat XCoPat (GhcPass id)
NoExtField
noExtField (KindCoercion -> HsWrapper
mkWpCastN KindCoercion
co) Pat (GhcPass id)
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
forall (id :: Pass).
HsWrapper -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
mkLHsWrap (TcEvBinds -> HsWrapper
mkWpLet TcEvBinds
ev_binds) LHsExpr GhcTc
expr

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

mkFunBind :: Origin -> Located RdrName -> [LMatch GhcPs (LHsExpr GhcPs)]
          -> HsBind GhcPs
-- ^ Not infix, with place holders for coercion and free vars
mkFunBind :: Origin
-> Located RdrName
-> [LMatch GhcPs (LHsExpr GhcPs)]
-> HsBind GhcPs
mkFunBind Origin
origin Located RdrName
fn [LMatch GhcPs (LHsExpr GhcPs)]
ms
  = FunBind :: forall idL idR.
XFunBind idL idR
-> Located (IdP idL)
-> MatchGroup idR (LHsExpr idR)
-> HsWrapper
-> [Tickish TyVar]
-> HsBindLR idL idR
FunBind { fun_id :: Located (IdP GhcPs)
fun_id = Located RdrName
Located (IdP GhcPs)
fn
            , fun_matches :: MatchGroup GhcPs (LHsExpr GhcPs)
fun_matches = Origin
-> [LMatch GhcPs (LHsExpr GhcPs)]
-> MatchGroup GhcPs (LHsExpr GhcPs)
forall name (body :: * -> *).
(XMG name (Located (body name)) ~ NoExtField) =>
Origin
-> [LMatch name (Located (body name))]
-> MatchGroup name (Located (body name))
mkMatchGroup Origin
origin [LMatch GhcPs (LHsExpr GhcPs)]
ms
            , fun_co_fn :: HsWrapper
fun_co_fn = HsWrapper
idHsWrapper
            , fun_ext :: XFunBind GhcPs GhcPs
fun_ext = XFunBind GhcPs GhcPs
NoExtField
noExtField
            , fun_tick :: [Tickish TyVar]
fun_tick = [] }

mkTopFunBind :: Origin -> Located Name -> [LMatch GhcRn (LHsExpr GhcRn)]
             -> HsBind GhcRn
-- ^ In Name-land, with empty bind_fvs
mkTopFunBind :: Origin
-> Located Name -> [LMatch GhcRn (LHsExpr GhcRn)] -> HsBind GhcRn
mkTopFunBind Origin
origin Located Name
fn [LMatch GhcRn (LHsExpr GhcRn)]
ms = FunBind :: forall idL idR.
XFunBind idL idR
-> Located (IdP idL)
-> MatchGroup idR (LHsExpr idR)
-> HsWrapper
-> [Tickish TyVar]
-> HsBindLR idL idR
FunBind { fun_id :: Located (IdP GhcRn)
fun_id = Located Name
Located (IdP GhcRn)
fn
                                    , fun_matches :: MatchGroup GhcRn (LHsExpr GhcRn)
fun_matches = Origin
-> [LMatch GhcRn (LHsExpr GhcRn)]
-> MatchGroup GhcRn (LHsExpr GhcRn)
forall name (body :: * -> *).
(XMG name (Located (body name)) ~ NoExtField) =>
Origin
-> [LMatch name (Located (body name))]
-> MatchGroup name (Located (body name))
mkMatchGroup Origin
origin [LMatch GhcRn (LHsExpr GhcRn)]
ms
                                    , fun_co_fn :: HsWrapper
fun_co_fn = HsWrapper
idHsWrapper
                                    , fun_ext :: XFunBind GhcRn GhcRn
fun_ext  = NameSet
XFunBind GhcRn GhcRn
emptyNameSet -- NB: closed
                                                              --     binding
                                    , fun_tick :: [Tickish TyVar]
fun_tick = [] }

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 (GhcPass p) -> LHsExpr (GhcPass p) -> LHsBind (GhcPass p)
mkVarBind :: IdP (GhcPass p) -> LHsExpr (GhcPass p) -> LHsBind (GhcPass p)
mkVarBind IdP (GhcPass p)
var LHsExpr (GhcPass p)
rhs = SrcSpan -> SrcSpanLess (LHsBind (GhcPass p)) -> LHsBind (GhcPass p)
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL (LHsExpr (GhcPass p) -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc LHsExpr (GhcPass p)
rhs) (SrcSpanLess (LHsBind (GhcPass p)) -> LHsBind (GhcPass p))
-> SrcSpanLess (LHsBind (GhcPass p)) -> LHsBind (GhcPass p)
forall a b. (a -> b) -> a -> b
$
                    VarBind :: forall idL idR.
XVarBind idL idR
-> IdP idL -> LHsExpr idR -> Bool -> HsBindLR idL idR
VarBind { var_ext :: XVarBind (GhcPass p) (GhcPass p)
var_ext = XVarBind (GhcPass p) (GhcPass p)
NoExtField
noExtField,
                              var_id :: IdP (GhcPass p)
var_id = IdP (GhcPass p)
var, var_rhs :: LHsExpr (GhcPass p)
var_rhs = LHsExpr (GhcPass p)
rhs, var_inline :: Bool
var_inline = Bool
False }

mkPatSynBind :: Located RdrName -> HsPatSynDetails (Located RdrName)
             -> LPat GhcPs -> HsPatSynDir GhcPs -> HsBind GhcPs
mkPatSynBind :: Located RdrName
-> HsPatSynDetails (Located RdrName)
-> LPat GhcPs
-> HsPatSynDir GhcPs
-> HsBind GhcPs
mkPatSynBind Located RdrName
name HsPatSynDetails (Located RdrName)
details LPat GhcPs
lpat HsPatSynDir GhcPs
dir = 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 :: forall idL idR.
XPSB idL idR
-> Located (IdP idL)
-> HsPatSynDetails (Located (IdP idR))
-> LPat idR
-> HsPatSynDir idR
-> PatSynBind idL idR
PSB{ psb_ext :: XPSB GhcPs GhcPs
psb_ext = XPSB GhcPs GhcPs
NoExtField
noExtField
             , psb_id :: Located (IdP GhcPs)
psb_id = Located RdrName
Located (IdP GhcPs)
name
             , psb_args :: HsPatSynDetails (Located (IdP GhcPs))
psb_args = HsPatSynDetails (Located RdrName)
HsPatSynDetails (Located (IdP 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 :: HsBindLR id1 id2 -> Bool
isInfixFunBind :: HsBindLR id1 id2 -> Bool
isInfixFunBind (FunBind XFunBind id1 id2
_ Located (IdP id1)
_ (MG XMG id2 (LHsExpr id2)
_ Located [LMatch id2 (LHsExpr id2)]
matches Origin
_) HsWrapper
_ [Tickish TyVar]
_)
  = (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
. LMatch id2 (LHsExpr id2) -> Match id2 (LHsExpr id2)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) (Located [LMatch id2 (LHsExpr id2)]
-> SrcSpanLess (Located [LMatch id2 (LHsExpr id2)])
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located [LMatch id2 (LHsExpr id2)]
matches)
isInfixFunBind HsBindLR id1 id2
_ = Bool
False


------------
-- | 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
  = SrcSpan -> SrcSpanLess (LHsBind GhcPs) -> LHsBind GhcPs
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
loc (SrcSpanLess (LHsBind GhcPs) -> LHsBind GhcPs)
-> SrcSpanLess (LHsBind GhcPs) -> LHsBind GhcPs
forall a b. (a -> b) -> a -> b
$ Origin
-> Located RdrName
-> [LMatch GhcPs (LHsExpr GhcPs)]
-> HsBind GhcPs
mkFunBind Origin
Generated (SrcSpan -> SrcSpanLess (Located RdrName) -> Located RdrName
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
loc SrcSpanLess (Located RdrName)
RdrName
fun)
              [HsMatchContext (NameOrRdrName (IdP GhcPs))
-> [LPat GhcPs]
-> LHsExpr GhcPs
-> Located (HsLocalBinds GhcPs)
-> LMatch GhcPs (LHsExpr GhcPs)
forall (p :: Pass).
HsMatchContext (NameOrRdrName (IdP (GhcPass p)))
-> [LPat (GhcPass p)]
-> LHsExpr (GhcPass p)
-> Located (HsLocalBinds (GhcPass p))
-> LMatch (GhcPass p) (LHsExpr (GhcPass p))
mkMatch (Located RdrName -> HsMatchContext RdrName
forall id. Located id -> HsMatchContext id
mkPrefixFunRhs (SrcSpan -> SrcSpanLess (Located RdrName) -> Located RdrName
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
loc SrcSpanLess (Located RdrName)
RdrName
fun)) [LPat GhcPs]
pats LHsExpr GhcPs
expr
                       (SrcSpanLess (Located (HsLocalBinds GhcPs))
-> Located (HsLocalBinds GhcPs)
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc SrcSpanLess (Located (HsLocalBinds GhcPs))
forall (a :: Pass) (b :: Pass).
HsLocalBindsLR (GhcPass a) (GhcPass b)
emptyLocalBinds)]

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

------------
mkMatch :: HsMatchContext (NameOrRdrName (IdP (GhcPass p)))
        -> [LPat (GhcPass p)] -> LHsExpr (GhcPass p)
        -> Located (HsLocalBinds (GhcPass p))
        -> LMatch (GhcPass p) (LHsExpr (GhcPass p))
mkMatch :: HsMatchContext (NameOrRdrName (IdP (GhcPass p)))
-> [LPat (GhcPass p)]
-> LHsExpr (GhcPass p)
-> Located (HsLocalBinds (GhcPass p))
-> LMatch (GhcPass p) (LHsExpr (GhcPass p))
mkMatch HsMatchContext (NameOrRdrName (IdP (GhcPass p)))
ctxt [LPat (GhcPass p)]
pats LHsExpr (GhcPass p)
expr Located (HsLocalBinds (GhcPass p))
lbinds
  = SrcSpanLess (LMatch (GhcPass p) (LHsExpr (GhcPass p)))
-> LMatch (GhcPass p) (LHsExpr (GhcPass p))
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (Match :: forall p body.
XCMatch p body
-> HsMatchContext (NameOrRdrName (IdP p))
-> [LPat p]
-> GRHSs p body
-> Match p body
Match { m_ext :: XCMatch (GhcPass p) (LHsExpr (GhcPass p))
m_ext   = XCMatch (GhcPass p) (LHsExpr (GhcPass p))
NoExtField
noExtField
                 , m_ctxt :: HsMatchContext (NameOrRdrName (IdP (GhcPass p)))
m_ctxt  = HsMatchContext (NameOrRdrName (IdP (GhcPass p)))
ctxt
                 , m_pats :: [LPat (GhcPass p)]
m_pats  = (Located (Pat (GhcPass p)) -> Located (Pat (GhcPass p)))
-> [Located (Pat (GhcPass p))] -> [Located (Pat (GhcPass p))]
forall a b. (a -> b) -> [a] -> [b]
map Located (Pat (GhcPass p)) -> Located (Pat (GhcPass p))
forall p.
(HasSrcSpan (XRec p Pat), XParPat p ~ NoExtField,
 SrcSpanLess (XRec p Pat) ~ Pat p) =>
XRec p Pat -> XRec p Pat
paren [Located (Pat (GhcPass p))]
[LPat (GhcPass p)]
pats
                 , m_grhss :: GRHSs (GhcPass p) (LHsExpr (GhcPass p))
m_grhss = XCGRHSs (GhcPass p) (LHsExpr (GhcPass p))
-> [LGRHS (GhcPass p) (LHsExpr (GhcPass p))]
-> Located (HsLocalBinds (GhcPass p))
-> GRHSs (GhcPass p) (LHsExpr (GhcPass p))
forall p body.
XCGRHSs p body -> [LGRHS p body] -> LHsLocalBinds p -> GRHSs p body
GRHSs XCGRHSs (GhcPass p) (LHsExpr (GhcPass p))
NoExtField
noExtField (SrcSpan
-> LHsExpr (GhcPass p) -> [LGRHS (GhcPass p) (LHsExpr (GhcPass p))]
forall (body :: * -> *) (p :: Pass).
SrcSpan
-> Located (body (GhcPass p))
-> [LGRHS (GhcPass p) (Located (body (GhcPass p)))]
unguardedRHS SrcSpan
noSrcSpan LHsExpr (GhcPass p)
expr) Located (HsLocalBinds (GhcPass p))
lbinds })
  where
    paren :: XRec p Pat -> XRec p Pat
paren lp :: XRec p Pat
lp@(XRec p Pat -> Located (SrcSpanLess (XRec p Pat))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
l SrcSpanLess (XRec p Pat)
p)
      | PprPrec -> Pat p -> Bool
forall p. PprPrec -> Pat p -> Bool
patNeedsParens PprPrec
appPrec SrcSpanLess (XRec p Pat)
Pat p
p = SrcSpan -> SrcSpanLess (XRec p Pat) -> XRec p Pat
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
l (XParPat p -> XRec p Pat -> Pat p
forall p. XParPat p -> LPat p -> Pat p
ParPat XParPat p
NoExtField
noExtField XRec p Pat
lp)
      | Bool
otherwise                = XRec p Pat
lp

{-
************************************************************************
*                                                                      *
        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 [Unlifted id check in isUnliftedHsBind]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The function isUnliftedHsBind is used to complain if we make a top-level
binding for a variable of unlifted type.

Such a binding is illegal if the top-level binding would be unlifted;
but also if the local letrec generated by desugaring AbsBinds would be.
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 generally we check the abe_mono types.

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

----------------- 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 [Unlifted id check in isUnliftedHsBind]. For usage
-- information, see Note [Strict binds check] is DsBinds.
isUnliftedHsBind :: HsBind GhcTc -> Bool  -- works only over typechecked binds
isUnliftedHsBind :: HsBind GhcTc -> Bool
isUnliftedHsBind HsBind GhcTc
bind
  | AbsBinds { abs_exports :: forall idL idR. HsBindLR idL idR -> [ABExport idL]
abs_exports = [ABExport GhcTc]
exports, abs_sig :: forall idL idR. HsBindLR idL idR -> Bool
abs_sig = Bool
has_sig } <- HsBind GhcTc
bind
  = if Bool
has_sig
    then (ABExport GhcTc -> Bool) -> [ABExport GhcTc] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (TyVar -> Bool
is_unlifted_id (TyVar -> Bool)
-> (ABExport GhcTc -> TyVar) -> ABExport GhcTc -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ABExport GhcTc -> TyVar
forall p. ABExport p -> IdP p
abe_poly) [ABExport GhcTc]
exports
    else (ABExport GhcTc -> Bool) -> [ABExport GhcTc] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (TyVar -> Bool
is_unlifted_id (TyVar -> Bool)
-> (ABExport GhcTc -> TyVar) -> ABExport GhcTc -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ABExport GhcTc -> TyVar
forall p. ABExport p -> IdP p
abe_mono) [ABExport GhcTc]
exports
    -- If has_sig is True we wil 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 #)

  | Bool
otherwise
  = (TyVar -> Bool) -> [TyVar] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any TyVar -> Bool
is_unlifted_id (HsBind GhcTc -> [IdP GhcTc]
forall p idR.
(SrcSpanLess (LPat p) ~ Pat p, HasSrcSpan (LPat p)) =>
HsBindLR p idR -> [IdP p]
collectHsBindBinders HsBind GhcTc
bind)
  where
    is_unlifted_id :: TyVar -> Bool
is_unlifted_id TyVar
id = HasDebugCallStack => Type -> Bool
Type -> Bool
isUnliftedType (TyVar -> Type
idType TyVar
id)

-- | Is a binding a strict variable or pattern bind (e.g. @!x = ...@)?
isBangedHsBind :: HsBind GhcTc -> Bool
isBangedHsBind :: HsBind GhcTc -> Bool
isBangedHsBind (AbsBinds { abs_binds :: forall idL idR. HsBindLR idL idR -> LHsBinds idL
abs_binds = LHsBinds GhcTc
binds })
  = (LHsBindLR GhcTc GhcTc -> Bool) -> LHsBinds GhcTc -> Bool
forall a. (a -> Bool) -> Bag a -> Bool
anyBag (HsBind GhcTc -> Bool
isBangedHsBind (HsBind GhcTc -> Bool)
-> (LHsBindLR GhcTc GhcTc -> HsBind GhcTc)
-> LHsBindLR GhcTc GhcTc
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsBindLR GhcTc GhcTc -> HsBind GhcTc
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) LHsBinds GhcTc
binds
isBangedHsBind (FunBind {fun_matches :: forall idL idR. HsBindLR idL idR -> MatchGroup idR (LHsExpr idR)
fun_matches = MatchGroup GhcTc (LHsExpr GhcTc)
matches})
  | [dL->L _ match] <- Located [LMatch GhcTc (LHsExpr GhcTc)]
-> SrcSpanLess (Located [LMatch GhcTc (LHsExpr GhcTc)])
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (Located [LMatch GhcTc (LHsExpr GhcTc)]
 -> SrcSpanLess (Located [LMatch GhcTc (LHsExpr GhcTc)]))
-> Located [LMatch GhcTc (LHsExpr GhcTc)]
-> SrcSpanLess (Located [LMatch GhcTc (LHsExpr GhcTc)])
forall a b. (a -> b) -> a -> b
$ MatchGroup GhcTc (LHsExpr GhcTc)
-> Located [LMatch GhcTc (LHsExpr GhcTc)]
forall p body. MatchGroup p body -> Located [LMatch p body]
mg_alts MatchGroup GhcTc (LHsExpr GhcTc)
matches
  , FunRhs{mc_strictness :: forall id. HsMatchContext id -> SrcStrictness
mc_strictness = SrcStrictness
SrcStrict} <- Match GhcTc (LHsExpr GhcTc)
-> HsMatchContext (NameOrRdrName (IdP GhcTc))
forall p body.
Match p body -> HsMatchContext (NameOrRdrName (IdP p))
m_ctxt SrcSpanLess (LMatch GhcTc (LHsExpr GhcTc))
Match GhcTc (LHsExpr 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 HsBind GhcTc
_
  = Bool
False

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

collectHsIdBinders, collectHsValBinders
  :: HsValBindsLR (GhcPass idL) (GhcPass idR) -> [IdP (GhcPass idL)]
-- ^ Collect Id binders only, or Ids + pattern synonyms, respectively
collectHsIdBinders :: HsValBindsLR (GhcPass idL) (GhcPass idR) -> [IdP (GhcPass idL)]
collectHsIdBinders  = Bool
-> HsValBindsLR (GhcPass idL) (GhcPass idR) -> [IdP (GhcPass idL)]
forall (idL :: Pass) (idR :: Pass).
Bool
-> HsValBindsLR (GhcPass idL) (GhcPass idR) -> [IdP (GhcPass idL)]
collect_hs_val_binders Bool
True
collectHsValBinders :: HsValBindsLR (GhcPass idL) (GhcPass idR) -> [IdP (GhcPass idL)]
collectHsValBinders = Bool
-> HsValBindsLR (GhcPass idL) (GhcPass idR) -> [IdP (GhcPass idL)]
forall (idL :: Pass) (idR :: Pass).
Bool
-> HsValBindsLR (GhcPass idL) (GhcPass idR) -> [IdP (GhcPass idL)]
collect_hs_val_binders Bool
False

collectHsBindBinders :: (SrcSpanLess (LPat p) ~ Pat p, HasSrcSpan (LPat p))=>
                        HsBindLR p idR -> [IdP p]
-- ^ Collect both Ids and pattern-synonym binders
collectHsBindBinders :: HsBindLR p idR -> [IdP p]
collectHsBindBinders HsBindLR p idR
b = Bool -> HsBindLR p idR -> [IdP p] -> [IdP p]
forall p idR.
(SrcSpanLess (LPat p) ~ Pat p, HasSrcSpan (LPat p)) =>
Bool -> HsBindLR p idR -> [IdP p] -> [IdP p]
collect_bind Bool
False HsBindLR p idR
b []

collectHsBindsBinders :: LHsBindsLR (GhcPass p) idR -> [IdP (GhcPass p)]
collectHsBindsBinders :: LHsBindsLR (GhcPass p) idR -> [IdP (GhcPass p)]
collectHsBindsBinders LHsBindsLR (GhcPass p) idR
binds = Bool
-> LHsBindsLR (GhcPass p) idR
-> [IdP (GhcPass p)]
-> [IdP (GhcPass p)]
forall (p :: Pass) idR.
Bool
-> LHsBindsLR (GhcPass p) idR
-> [IdP (GhcPass p)]
-> [IdP (GhcPass p)]
collect_binds Bool
False LHsBindsLR (GhcPass p) idR
binds []

collectHsBindListBinders :: [LHsBindLR (GhcPass p) idR] -> [IdP (GhcPass p)]
-- ^ Same as collectHsBindsBinders, but works over a list of bindings
collectHsBindListBinders :: [LHsBindLR (GhcPass p) idR] -> [IdP (GhcPass p)]
collectHsBindListBinders = (LHsBindLR (GhcPass p) idR
 -> [IdP (GhcPass p)] -> [IdP (GhcPass p)])
-> [IdP (GhcPass p)]
-> [LHsBindLR (GhcPass p) idR]
-> [IdP (GhcPass p)]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Bool
-> HsBindLR (GhcPass p) idR
-> [IdP (GhcPass p)]
-> [IdP (GhcPass p)]
forall p idR.
(SrcSpanLess (LPat p) ~ Pat p, HasSrcSpan (LPat p)) =>
Bool -> HsBindLR p idR -> [IdP p] -> [IdP p]
collect_bind Bool
False (HsBindLR (GhcPass p) idR
 -> [IdP (GhcPass p)] -> [IdP (GhcPass p)])
-> (LHsBindLR (GhcPass p) idR -> HsBindLR (GhcPass p) idR)
-> LHsBindLR (GhcPass p) idR
-> [IdP (GhcPass p)]
-> [IdP (GhcPass p)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsBindLR (GhcPass p) idR -> HsBindLR (GhcPass p) idR
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) []

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

collect_out_binds :: Bool -> [(RecFlag, LHsBinds (GhcPass p))] ->
                     [IdP (GhcPass p)]
collect_out_binds :: Bool -> [(RecFlag, LHsBinds (GhcPass p))] -> [IdP (GhcPass p)]
collect_out_binds Bool
ps = ((RecFlag, LHsBinds (GhcPass p))
 -> [IdP (GhcPass p)] -> [IdP (GhcPass p)])
-> [IdP (GhcPass p)]
-> [(RecFlag, LHsBinds (GhcPass p))]
-> [IdP (GhcPass p)]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Bool
-> LHsBinds (GhcPass p) -> [IdP (GhcPass p)] -> [IdP (GhcPass p)]
forall (p :: Pass) idR.
Bool
-> LHsBindsLR (GhcPass p) idR
-> [IdP (GhcPass p)]
-> [IdP (GhcPass p)]
collect_binds Bool
ps (LHsBinds (GhcPass p) -> [IdP (GhcPass p)] -> [IdP (GhcPass p)])
-> ((RecFlag, LHsBinds (GhcPass p)) -> LHsBinds (GhcPass p))
-> (RecFlag, LHsBinds (GhcPass p))
-> [IdP (GhcPass p)]
-> [IdP (GhcPass p)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RecFlag, LHsBinds (GhcPass p)) -> LHsBinds (GhcPass p)
forall a b. (a, b) -> b
snd) []

collect_binds :: Bool -> LHsBindsLR (GhcPass p) idR ->
                 [IdP (GhcPass p)] -> [IdP (GhcPass p)]
-- ^ Collect Ids, or Ids + pattern synonyms, depending on boolean flag
collect_binds :: Bool
-> LHsBindsLR (GhcPass p) idR
-> [IdP (GhcPass p)]
-> [IdP (GhcPass p)]
collect_binds Bool
ps LHsBindsLR (GhcPass p) idR
binds [IdP (GhcPass p)]
acc = (LHsBindLR (GhcPass p) idR
 -> [IdP (GhcPass p)] -> [IdP (GhcPass p)])
-> [IdP (GhcPass p)]
-> LHsBindsLR (GhcPass p) idR
-> [IdP (GhcPass p)]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Bool
-> HsBindLR (GhcPass p) idR
-> [IdP (GhcPass p)]
-> [IdP (GhcPass p)]
forall p idR.
(SrcSpanLess (LPat p) ~ Pat p, HasSrcSpan (LPat p)) =>
Bool -> HsBindLR p idR -> [IdP p] -> [IdP p]
collect_bind Bool
ps (HsBindLR (GhcPass p) idR
 -> [IdP (GhcPass p)] -> [IdP (GhcPass p)])
-> (LHsBindLR (GhcPass p) idR -> HsBindLR (GhcPass p) idR)
-> LHsBindLR (GhcPass p) idR
-> [IdP (GhcPass p)]
-> [IdP (GhcPass p)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsBindLR (GhcPass p) idR -> HsBindLR (GhcPass p) idR
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) [IdP (GhcPass p)]
acc LHsBindsLR (GhcPass p) idR
binds

collect_bind :: (SrcSpanLess (LPat p) ~ Pat p , HasSrcSpan (LPat p)) =>
                Bool -> HsBindLR p idR -> [IdP p] -> [IdP p]
collect_bind :: Bool -> HsBindLR p idR -> [IdP p] -> [IdP p]
collect_bind Bool
_ (PatBind { pat_lhs :: forall idL idR. HsBindLR idL idR -> LPat idL
pat_lhs = LPat p
p })           [IdP p]
acc = LPat p -> [IdP p] -> [IdP p]
forall p.
(SrcSpanLess (LPat p) ~ Pat p, HasSrcSpan (LPat p)) =>
LPat p -> [IdP p] -> [IdP p]
collect_lpat LPat p
p [IdP p]
acc
collect_bind Bool
_ (FunBind { fun_id :: forall idL idR. HsBindLR idL idR -> Located (IdP idL)
fun_id = (Located (IdP p) -> Located (SrcSpanLess (Located (IdP p)))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ SrcSpanLess (Located (IdP p))
f) })  [IdP p]
acc = SrcSpanLess (Located (IdP p))
IdP p
f IdP p -> [IdP p] -> [IdP p]
forall a. a -> [a] -> [a]
: [IdP p]
acc
collect_bind Bool
_ (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
_ (AbsBinds { abs_exports :: forall idL idR. HsBindLR idL idR -> [ABExport idL]
abs_exports = [ABExport p]
dbinds }) [IdP p]
acc = (ABExport p -> IdP p) -> [ABExport p] -> [IdP p]
forall a b. (a -> b) -> [a] -> [b]
map ABExport p -> IdP p
forall p. ABExport p -> IdP p
abe_poly [ABExport p]
dbinds [IdP p] -> [IdP p] -> [IdP p]
forall a. [a] -> [a] -> [a]
++ [IdP p]
acc
        -- I don't think we want the binders from the abe_binds

        -- binding (hence see AbsBinds) is in zonking in TcHsSyn
collect_bind Bool
omitPatSyn (PatSynBind XPatSynBind p idR
_ (PSB { psb_id :: forall idL idR. PatSynBind idL idR -> Located (IdP idL)
psb_id = (Located (IdP p) -> Located (SrcSpanLess (Located (IdP p)))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ SrcSpanLess (Located (IdP p))
ps) })) [IdP p]
acc
  | Bool
omitPatSyn                  = [IdP p]
acc
  | Bool
otherwise                   = SrcSpanLess (Located (IdP p))
IdP p
ps IdP p -> [IdP p] -> [IdP p]
forall a. a -> [a] -> [a]
: [IdP p]
acc
collect_bind Bool
_ (PatSynBind XPatSynBind p idR
_ (XPatSynBind XXPatSynBind p idR
_)) [IdP p]
acc = [IdP p]
acc
collect_bind Bool
_ (XHsBindsLR XXHsBindsLR p idR
_) [IdP p]
acc = [IdP p]
acc

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

----------------- Statements --------------------------
collectLStmtsBinders :: [LStmtLR (GhcPass idL) (GhcPass idR) body]
                     -> [IdP (GhcPass idL)]
collectLStmtsBinders :: [LStmtLR (GhcPass idL) (GhcPass idR) body] -> [IdP (GhcPass idL)]
collectLStmtsBinders = (LStmtLR (GhcPass idL) (GhcPass idR) body -> [IdP (GhcPass idL)])
-> [LStmtLR (GhcPass idL) (GhcPass idR) body]
-> [IdP (GhcPass idL)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap LStmtLR (GhcPass idL) (GhcPass idR) body -> [IdP (GhcPass idL)]
forall (idL :: Pass) (idR :: Pass) body.
LStmtLR (GhcPass idL) (GhcPass idR) body -> [IdP (GhcPass idL)]
collectLStmtBinders

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

collectLStmtBinders :: LStmtLR (GhcPass idL) (GhcPass idR) body
                    -> [IdP (GhcPass idL)]
collectLStmtBinders :: LStmtLR (GhcPass idL) (GhcPass idR) body -> [IdP (GhcPass idL)]
collectLStmtBinders = StmtLR (GhcPass idL) (GhcPass idR) body -> [IdP (GhcPass idL)]
forall (idL :: Pass) (idR :: Pass) body.
StmtLR (GhcPass idL) (GhcPass idR) body -> [IdP (GhcPass idL)]
collectStmtBinders (StmtLR (GhcPass idL) (GhcPass idR) body -> [IdP (GhcPass idL)])
-> (LStmtLR (GhcPass idL) (GhcPass idR) body
    -> StmtLR (GhcPass idL) (GhcPass idR) body)
-> LStmtLR (GhcPass idL) (GhcPass idR) body
-> [IdP (GhcPass idL)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LStmtLR (GhcPass idL) (GhcPass idR) body
-> StmtLR (GhcPass idL) (GhcPass idR) body
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc

collectStmtBinders :: StmtLR (GhcPass idL) (GhcPass idR) body
                   -> [IdP (GhcPass idL)]
  -- Id Binders for a Stmt... [but what about pattern-sig type vars]?
collectStmtBinders :: StmtLR (GhcPass idL) (GhcPass idR) body -> [IdP (GhcPass idL)]
collectStmtBinders (BindStmt XBindStmt (GhcPass idL) (GhcPass idR) body
_ LPat (GhcPass idL)
pat body
_ SyntaxExpr (GhcPass idR)
_ SyntaxExpr (GhcPass idR)
_)  = LPat (GhcPass idL) -> [IdP (GhcPass idL)]
forall (p :: Pass). LPat (GhcPass p) -> [IdP (GhcPass p)]
collectPatBinders LPat (GhcPass idL)
pat
collectStmtBinders (LetStmt XLetStmt (GhcPass idL) (GhcPass idR) body
_  LHsLocalBindsLR (GhcPass idL) (GhcPass idR)
binds)      = HsLocalBindsLR (GhcPass idL) (GhcPass idR) -> [IdP (GhcPass idL)]
forall (idL :: Pass) (idR :: Pass).
HsLocalBindsLR (GhcPass idL) (GhcPass idR) -> [IdP (GhcPass idL)]
collectLocalBinders (LHsLocalBindsLR (GhcPass idL) (GhcPass idR)
-> SrcSpanLess (LHsLocalBindsLR (GhcPass idL) (GhcPass idR))
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsLocalBindsLR (GhcPass idL) (GhcPass idR)
binds)
collectStmtBinders (BodyStmt {})           = []
collectStmtBinders (LastStmt {})           = []
collectStmtBinders (ParStmt XParStmt (GhcPass idL) (GhcPass idR) body
_ [ParStmtBlock (GhcPass idL) (GhcPass idR)]
xs HsExpr (GhcPass idR)
_ SyntaxExpr (GhcPass idR)
_)      = [LStmtLR (GhcPass idL) (GhcPass idL) (LHsExpr (GhcPass idL))]
-> [IdP (GhcPass idL)]
forall (idL :: Pass) (idR :: Pass) body.
[LStmtLR (GhcPass idL) (GhcPass idR) body] -> [IdP (GhcPass idL)]
collectLStmtsBinders
                                    ([LStmtLR (GhcPass idL) (GhcPass idL) (LHsExpr (GhcPass idL))]
 -> [IdP (GhcPass idL)])
-> [LStmtLR (GhcPass idL) (GhcPass idL) (LHsExpr (GhcPass idL))]
-> [IdP (GhcPass idL)]
forall a b. (a -> b) -> a -> b
$ [LStmtLR (GhcPass idL) (GhcPass idL) (LHsExpr (GhcPass idL))
s | ParStmtBlock XParStmtBlock (GhcPass idL) (GhcPass idR)
_ [LStmtLR (GhcPass idL) (GhcPass idL) (LHsExpr (GhcPass idL))]
ss [IdP (GhcPass idR)]
_ SyntaxExpr (GhcPass idR)
_ <- [ParStmtBlock (GhcPass idL) (GhcPass idR)]
xs, LStmtLR (GhcPass idL) (GhcPass idL) (LHsExpr (GhcPass idL))
s <- [LStmtLR (GhcPass idL) (GhcPass idL) (LHsExpr (GhcPass idL))]
ss]
collectStmtBinders (TransStmt { trS_stmts :: forall idL idR body. StmtLR idL idR body -> [ExprLStmt idL]
trS_stmts = [LStmtLR (GhcPass idL) (GhcPass idL) (LHsExpr (GhcPass idL))]
stmts }) = [LStmtLR (GhcPass idL) (GhcPass idL) (LHsExpr (GhcPass idL))]
-> [IdP (GhcPass idL)]
forall (idL :: Pass) (idR :: Pass) body.
[LStmtLR (GhcPass idL) (GhcPass idR) body] -> [IdP (GhcPass idL)]
collectLStmtsBinders [LStmtLR (GhcPass idL) (GhcPass idL) (LHsExpr (GhcPass idL))]
stmts
collectStmtBinders (RecStmt { recS_stmts :: forall idL idR body. StmtLR idL idR body -> [LStmtLR idL idR body]
recS_stmts = [LStmtLR (GhcPass idL) (GhcPass idR) body]
ss })     = [LStmtLR (GhcPass idL) (GhcPass idR) body] -> [IdP (GhcPass idL)]
forall (idL :: Pass) (idR :: Pass) body.
[LStmtLR (GhcPass idL) (GhcPass idR) body] -> [IdP (GhcPass idL)]
collectLStmtsBinders [LStmtLR (GhcPass idL) (GhcPass idR) body]
ss
collectStmtBinders (ApplicativeStmt XApplicativeStmt (GhcPass idL) (GhcPass idR) body
_ [(SyntaxExpr (GhcPass idR), ApplicativeArg (GhcPass idL))]
args Maybe (SyntaxExpr (GhcPass idR))
_) = ((SyntaxExpr (GhcPass idR), ApplicativeArg (GhcPass idL))
 -> [IdP (GhcPass idL)])
-> [(SyntaxExpr (GhcPass idR), ApplicativeArg (GhcPass idL))]
-> [IdP (GhcPass idL)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (SyntaxExpr (GhcPass idR), ApplicativeArg (GhcPass idL))
-> [IdP (GhcPass idL)]
forall a (p :: Pass).
(a, ApplicativeArg (GhcPass p)) -> [IdP (GhcPass p)]
collectArgBinders [(SyntaxExpr (GhcPass idR), ApplicativeArg (GhcPass idL))]
args
 where
  collectArgBinders :: (a, ApplicativeArg (GhcPass p)) -> [IdP (GhcPass p)]
collectArgBinders (a
_, ApplicativeArgOne { app_arg_pattern :: forall idL. ApplicativeArg idL -> LPat idL
app_arg_pattern = LPat (GhcPass p)
pat }) = LPat (GhcPass p) -> [IdP (GhcPass p)]
forall (p :: Pass). LPat (GhcPass p) -> [IdP (GhcPass p)]
collectPatBinders LPat (GhcPass p)
pat
  collectArgBinders (a
_, ApplicativeArgMany { bv_pattern :: forall idL. ApplicativeArg idL -> LPat idL
bv_pattern = LPat (GhcPass p)
pat }) = LPat (GhcPass p) -> [IdP (GhcPass p)]
forall (p :: Pass). LPat (GhcPass p) -> [IdP (GhcPass p)]
collectPatBinders LPat (GhcPass p)
pat
  collectArgBinders (a, ApplicativeArg (GhcPass p))
_ = []
collectStmtBinders (XStmtLR XXStmtLR (GhcPass idL) (GhcPass idR) body
nec) = NoExtCon -> [IdP (GhcPass idL)]
forall a. NoExtCon -> a
noExtCon XXStmtLR (GhcPass idL) (GhcPass idR) body
NoExtCon
nec


----------------- Patterns --------------------------
collectPatBinders :: LPat (GhcPass p) -> [IdP (GhcPass p)]
collectPatBinders :: LPat (GhcPass p) -> [IdP (GhcPass p)]
collectPatBinders LPat (GhcPass p)
pat = LPat (GhcPass p) -> [IdP (GhcPass p)] -> [IdP (GhcPass p)]
forall p.
(SrcSpanLess (LPat p) ~ Pat p, HasSrcSpan (LPat p)) =>
LPat p -> [IdP p] -> [IdP p]
collect_lpat LPat (GhcPass p)
pat []

collectPatsBinders :: [LPat (GhcPass p)] -> [IdP (GhcPass p)]
collectPatsBinders :: [LPat (GhcPass p)] -> [IdP (GhcPass p)]
collectPatsBinders [LPat (GhcPass p)]
pats = (Located (Pat (GhcPass p))
 -> [IdP (GhcPass p)] -> [IdP (GhcPass p)])
-> [IdP (GhcPass p)]
-> [Located (Pat (GhcPass p))]
-> [IdP (GhcPass p)]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Located (Pat (GhcPass p)) -> [IdP (GhcPass p)] -> [IdP (GhcPass p)]
forall p.
(SrcSpanLess (LPat p) ~ Pat p, HasSrcSpan (LPat p)) =>
LPat p -> [IdP p] -> [IdP p]
collect_lpat [] [Located (Pat (GhcPass p))]
[LPat (GhcPass p)]
pats

-------------
collect_lpat :: (SrcSpanLess (LPat p) ~ Pat p , HasSrcSpan (LPat p)) =>
                 LPat p -> [IdP p] -> [IdP p]
collect_lpat :: LPat p -> [IdP p] -> [IdP p]
collect_lpat LPat p
p [IdP p]
bndrs
  = Pat p -> [IdP p]
go (LPat p -> SrcSpanLess (LPat p)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LPat p
p)
  where
    go :: Pat p -> [IdP p]
go (VarPat XVarPat p
_ Located (IdP p)
var)             = Located (IdP p) -> SrcSpanLess (Located (IdP p))
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located (IdP p)
var IdP p -> [IdP p] -> [IdP p]
forall a. a -> [a] -> [a]
: [IdP p]
bndrs
    go (WildPat XWildPat p
_)                = [IdP p]
bndrs
    go (LazyPat XLazyPat p
_ LPat p
pat)            = LPat p -> [IdP p] -> [IdP p]
forall p.
(SrcSpanLess (LPat p) ~ Pat p, HasSrcSpan (LPat p)) =>
LPat p -> [IdP p] -> [IdP p]
collect_lpat LPat p
pat [IdP p]
bndrs
    go (BangPat XBangPat p
_ LPat p
pat)            = LPat p -> [IdP p] -> [IdP p]
forall p.
(SrcSpanLess (LPat p) ~ Pat p, HasSrcSpan (LPat p)) =>
LPat p -> [IdP p] -> [IdP p]
collect_lpat LPat p
pat [IdP p]
bndrs
    go (AsPat XAsPat p
_ Located (IdP p)
a LPat p
pat)            = Located (IdP p) -> SrcSpanLess (Located (IdP p))
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located (IdP p)
a IdP p -> [IdP p] -> [IdP p]
forall a. a -> [a] -> [a]
: LPat p -> [IdP p] -> [IdP p]
forall p.
(SrcSpanLess (LPat p) ~ Pat p, HasSrcSpan (LPat p)) =>
LPat p -> [IdP p] -> [IdP p]
collect_lpat LPat p
pat [IdP p]
bndrs
    go (ViewPat XViewPat p
_ LHsExpr p
_ LPat p
pat)          = LPat p -> [IdP p] -> [IdP p]
forall p.
(SrcSpanLess (LPat p) ~ Pat p, HasSrcSpan (LPat p)) =>
LPat p -> [IdP p] -> [IdP p]
collect_lpat LPat p
pat [IdP p]
bndrs
    go (ParPat XParPat p
_ LPat p
pat)             = LPat p -> [IdP p] -> [IdP p]
forall p.
(SrcSpanLess (LPat p) ~ Pat p, HasSrcSpan (LPat p)) =>
LPat p -> [IdP p] -> [IdP p]
collect_lpat LPat p
pat [IdP p]
bndrs

    go (ListPat XListPat p
_ [LPat p]
pats)           = (LPat p -> [IdP p] -> [IdP p]) -> [IdP p] -> [LPat p] -> [IdP p]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr LPat p -> [IdP p] -> [IdP p]
forall p.
(SrcSpanLess (LPat p) ~ Pat p, HasSrcSpan (LPat p)) =>
LPat p -> [IdP p] -> [IdP p]
collect_lpat [IdP p]
bndrs [LPat p]
pats
    go (TuplePat XTuplePat p
_ [LPat p]
pats Boxity
_)        = (LPat p -> [IdP p] -> [IdP p]) -> [IdP p] -> [LPat p] -> [IdP p]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr LPat p -> [IdP p] -> [IdP p]
forall p.
(SrcSpanLess (LPat p) ~ Pat p, HasSrcSpan (LPat p)) =>
LPat p -> [IdP p] -> [IdP p]
collect_lpat [IdP p]
bndrs [LPat p]
pats
    go (SumPat XSumPat p
_ LPat p
pat Int
_ Int
_)         = LPat p -> [IdP p] -> [IdP p]
forall p.
(SrcSpanLess (LPat p) ~ Pat p, HasSrcSpan (LPat p)) =>
LPat p -> [IdP p] -> [IdP p]
collect_lpat LPat p
pat [IdP p]
bndrs

    go (ConPatIn Located (IdP p)
_ HsConPatDetails p
ps)            = (LPat p -> [IdP p] -> [IdP p]) -> [IdP p] -> [LPat p] -> [IdP p]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr LPat p -> [IdP p] -> [IdP p]
forall p.
(SrcSpanLess (LPat p) ~ Pat p, HasSrcSpan (LPat p)) =>
LPat p -> [IdP p] -> [IdP p]
collect_lpat [IdP p]
bndrs (HsConPatDetails p -> [LPat p]
forall p. HsConPatDetails p -> [LPat p]
hsConPatArgs HsConPatDetails p
ps)
    go (ConPatOut {pat_args :: forall p. Pat p -> HsConPatDetails p
pat_args=HsConPatDetails p
ps})  = (LPat p -> [IdP p] -> [IdP p]) -> [IdP p] -> [LPat p] -> [IdP p]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr LPat p -> [IdP p] -> [IdP p]
forall p.
(SrcSpanLess (LPat p) ~ Pat p, HasSrcSpan (LPat p)) =>
LPat p -> [IdP p] -> [IdP p]
collect_lpat [IdP p]
bndrs (HsConPatDetails p -> [LPat p]
forall p. HsConPatDetails p -> [LPat p]
hsConPatArgs HsConPatDetails p
ps)
        -- See Note [Dictionary binders in ConPatOut]
    go (LitPat XLitPat p
_ HsLit p
_)               = [IdP p]
bndrs
    go (NPat {})                  = [IdP p]
bndrs
    go (NPlusKPat XNPlusKPat p
_ Located (IdP p)
n Located (HsOverLit p)
_ HsOverLit p
_ SyntaxExpr p
_ SyntaxExpr p
_)    = Located (IdP p) -> SrcSpanLess (Located (IdP p))
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located (IdP p)
n IdP p -> [IdP p] -> [IdP p]
forall a. a -> [a] -> [a]
: [IdP p]
bndrs

    go (SigPat XSigPat p
_ LPat p
pat LHsSigWcType (NoGhcTc p)
_)           = LPat p -> [IdP p] -> [IdP p]
forall p.
(SrcSpanLess (LPat p) ~ Pat p, HasSrcSpan (LPat p)) =>
LPat p -> [IdP p] -> [IdP p]
collect_lpat LPat p
pat [IdP p]
bndrs

    go (SplicePat XSplicePat p
_ (HsSpliced XSpliced p
_ ThModFinalizers
_ (HsSplicedPat Pat p
pat)))
                                  = Pat p -> [IdP p]
go Pat p
pat
    go (SplicePat XSplicePat p
_ HsSplice p
_)            = [IdP p]
bndrs
    go (CoPat XCoPat p
_ HsWrapper
_ Pat p
pat Type
_)          = Pat p -> [IdP p]
go Pat p
pat
    go (XPat {})                  = [IdP p]
bndrs

{-
Note [Dictionary binders in ConPatOut] See also same Note in DsArrows
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Do *not* gather (a) dictionary and (b) dictionary bindings as binders
of a ConPatOut pattern.  For most calls it doesn't matter, because
it's pre-typechecker and there are no ConPatOuts.  But it does matter
more in the desugarer; for example, DsUtils.mkSelectorBinds uses
collectPatBinders.  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.)

Desugaring of arrow case expressions needs these bindings (see DsArrows
and arrowcase1), but SPJ (Jan 2007) says it's safer for it to use its
own pat-binder-collector:

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 DsUtils, we want just m,n as the variables bound.
-}

hsGroupBinders :: HsGroup GhcRn -> [Name]
hsGroupBinders :: HsGroup GhcRn -> [Name]
hsGroupBinders (HsGroup { hs_valds :: forall p. HsGroup p -> HsValBinds p
hs_valds = HsValBinds GhcRn
val_decls, hs_tyclds :: forall p. HsGroup p -> [TyClGroup p]
hs_tyclds = [TyClGroup GhcRn]
tycl_decls,
                          hs_fords :: forall p. HsGroup p -> [LForeignDecl p]
hs_fords = [LForeignDecl GhcRn]
foreign_decls })
  =  HsValBinds GhcRn -> [IdP GhcRn]
forall (idL :: Pass) (idR :: Pass).
HsValBindsLR (GhcPass idL) (GhcPass idR) -> [IdP (GhcPass idL)]
collectHsValBinders HsValBinds GhcRn
val_decls
  [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ [TyClGroup GhcRn] -> [LForeignDecl GhcRn] -> [Name]
hsTyClForeignBinders [TyClGroup GhcRn]
tycl_decls [LForeignDecl GhcRn]
foreign_decls
hsGroupBinders (XHsGroup XXHsGroup GhcRn
nec) = NoExtCon -> [Name]
forall a. NoExtCon -> a
noExtCon XXHsGroup GhcRn
NoExtCon
nec

hsTyClForeignBinders :: [TyClGroup GhcRn]
                     -> [LForeignDecl GhcRn]
                     -> [Name]
-- We need to look at instance declarations too,
-- because their associated types may bind data constructors
hsTyClForeignBinders :: [TyClGroup GhcRn] -> [LForeignDecl GhcRn] -> [Name]
hsTyClForeignBinders [TyClGroup GhcRn]
tycl_decls [LForeignDecl GhcRn]
foreign_decls
  =    (Located Name -> Name) -> [Located Name] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map Located Name -> Name
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc ([LForeignDecl GhcRn] -> [Located (IdP GhcRn)]
forall pass. [LForeignDecl pass] -> [Located (IdP pass)]
hsForeignDeclsBinders [LForeignDecl GhcRn]
foreign_decls)
    [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ ([Located Name], [LFieldOcc GhcRn]) -> [Name]
getSelectorNames
         ((TyClGroup GhcRn -> ([Located Name], [LFieldOcc GhcRn]))
-> [TyClGroup GhcRn] -> ([Located Name], [LFieldOcc GhcRn])
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Located (TyClDecl GhcRn) -> ([Located Name], [LFieldOcc GhcRn]))
-> [Located (TyClDecl GhcRn)]
-> ([Located Name], [LFieldOcc GhcRn])
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Located (TyClDecl GhcRn) -> ([Located Name], [LFieldOcc GhcRn])
forall (p :: Pass).
Located (TyClDecl (GhcPass p))
-> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
hsLTyClDeclBinders ([Located (TyClDecl GhcRn)] -> ([Located Name], [LFieldOcc GhcRn]))
-> (TyClGroup GhcRn -> [Located (TyClDecl GhcRn)])
-> TyClGroup GhcRn
-> ([Located Name], [LFieldOcc GhcRn])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TyClGroup GhcRn -> [Located (TyClDecl GhcRn)]
forall pass. TyClGroup pass -> [LTyClDecl pass]
group_tyclds) [TyClGroup GhcRn]
tycl_decls
         ([Located Name], [LFieldOcc GhcRn])
-> ([Located Name], [LFieldOcc GhcRn])
-> ([Located Name], [LFieldOcc GhcRn])
forall a. Monoid a => a -> a -> a
`mappend`
         (TyClGroup GhcRn -> ([Located Name], [LFieldOcc GhcRn]))
-> [TyClGroup GhcRn] -> ([Located Name], [LFieldOcc GhcRn])
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((LInstDecl GhcRn -> ([Located Name], [LFieldOcc GhcRn]))
-> [LInstDecl GhcRn] -> ([Located Name], [LFieldOcc GhcRn])
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap LInstDecl GhcRn -> ([Located Name], [LFieldOcc GhcRn])
forall (p :: Pass).
LInstDecl (GhcPass p)
-> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
hsLInstDeclBinders ([LInstDecl GhcRn] -> ([Located Name], [LFieldOcc GhcRn]))
-> (TyClGroup GhcRn -> [LInstDecl GhcRn])
-> TyClGroup GhcRn
-> ([Located Name], [LFieldOcc GhcRn])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TyClGroup GhcRn -> [LInstDecl GhcRn]
forall pass. TyClGroup pass -> [LInstDecl pass]
group_instds) [TyClGroup GhcRn]
tycl_decls)
  where
    getSelectorNames :: ([Located Name], [LFieldOcc GhcRn]) -> [Name]
    getSelectorNames :: ([Located Name], [LFieldOcc GhcRn]) -> [Name]
getSelectorNames ([Located Name]
ns, [LFieldOcc GhcRn]
fs) = (Located Name -> Name) -> [Located Name] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map Located Name -> Name
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc [Located Name]
ns [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ (LFieldOcc GhcRn -> Name) -> [LFieldOcc GhcRn] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (FieldOcc GhcRn -> Name
forall pass. FieldOcc pass -> XCFieldOcc pass
extFieldOcc (FieldOcc GhcRn -> Name)
-> (LFieldOcc GhcRn -> FieldOcc GhcRn) -> LFieldOcc GhcRn -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LFieldOcc GhcRn -> FieldOcc GhcRn
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) [LFieldOcc GhcRn]
fs

-------------------
hsLTyClDeclBinders :: Located (TyClDecl (GhcPass p))
                   -> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass 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 :: Located (TyClDecl (GhcPass p))
-> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
hsLTyClDeclBinders (Located (TyClDecl (GhcPass p))
-> Located (SrcSpanLess (Located (TyClDecl (GhcPass p))))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
loc (FamDecl { tcdFam = FamilyDecl
                                            { fdLName = (dL->L _ name) } }))
  = ([SrcSpan
-> SrcSpanLess (Located (IdP (GhcPass p)))
-> Located (IdP (GhcPass p))
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
loc SrcSpanLess (Located (IdP (GhcPass p)))
name], [])
hsLTyClDeclBinders (Located (TyClDecl (GhcPass p))
-> Located (SrcSpanLess (Located (TyClDecl (GhcPass p))))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ (FamDecl { tcdFam = XFamilyDecl nec }))
  = NoExtCon -> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
forall a. NoExtCon -> a
noExtCon XXFamilyDecl (GhcPass p)
NoExtCon
nec
hsLTyClDeclBinders (Located (TyClDecl (GhcPass p))
-> Located (SrcSpanLess (Located (TyClDecl (GhcPass p))))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
loc (SynDecl
                               { tcdLName = (dL->L _ name) }))
  = ([SrcSpan
-> SrcSpanLess (Located (IdP (GhcPass p)))
-> Located (IdP (GhcPass p))
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
loc SrcSpanLess (Located (IdP (GhcPass p)))
name], [])
hsLTyClDeclBinders (Located (TyClDecl (GhcPass p))
-> Located (SrcSpanLess (Located (TyClDecl (GhcPass p))))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
loc (ClassDecl
                               { tcdLName = (dL->L _ cls_name)
                               , tcdSigs  = sigs
                               , tcdATs   = ats }))
  = (SrcSpan
-> SrcSpanLess (Located (IdP (GhcPass p)))
-> Located (IdP (GhcPass p))
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
loc SrcSpanLess (Located (IdP (GhcPass p)))
cls_name Located (IdP (GhcPass p))
-> [Located (IdP (GhcPass p))] -> [Located (IdP (GhcPass p))]
forall a. a -> [a] -> [a]
:
     [ SrcSpan
-> SrcSpanLess (Located (IdP (GhcPass p)))
-> Located (IdP (GhcPass p))
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
fam_loc SrcSpanLess (Located (IdP (GhcPass p)))
IdP (GhcPass p)
fam_name | (LFamilyDecl (GhcPass p)
-> Located (SrcSpanLess (LFamilyDecl (GhcPass p)))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
fam_loc (FamilyDecl
                                        { fdLName = L _ fam_name })) <- [LFamilyDecl (GhcPass p)]
ats ]
     [Located (IdP (GhcPass p))]
-> [Located (IdP (GhcPass p))] -> [Located (IdP (GhcPass p))]
forall a. [a] -> [a] -> [a]
++
     [ SrcSpan
-> SrcSpanLess (Located (IdP (GhcPass p)))
-> Located (IdP (GhcPass p))
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
mem_loc SrcSpanLess (Located (IdP (GhcPass p)))
mem_name | (LSig (GhcPass p) -> Located (SrcSpanLess (LSig (GhcPass p)))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
mem_loc (ClassOpSig _ False ns _)) <- [LSig (GhcPass p)]
sigs
                           , (Located (IdP (GhcPass p))
-> Located (SrcSpanLess (Located (IdP (GhcPass p))))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ SrcSpanLess (Located (IdP (GhcPass p)))
mem_name) <- [Located (IdP (GhcPass p))]
ns ]
    , [])
hsLTyClDeclBinders (Located (TyClDecl (GhcPass p))
-> Located (SrcSpanLess (Located (TyClDecl (GhcPass p))))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
loc (DataDecl    { tcdLName = (dL->L _ name)
                                           , tcdDataDefn = defn }))
  = (\ ([Located (IdP (GhcPass p))]
xs, [LFieldOcc (GhcPass p)]
ys) -> (SrcSpan
-> SrcSpanLess (Located (IdP (GhcPass p)))
-> Located (IdP (GhcPass p))
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
loc SrcSpanLess (Located (IdP (GhcPass p)))
name Located (IdP (GhcPass p))
-> [Located (IdP (GhcPass p))] -> [Located (IdP (GhcPass p))]
forall a. a -> [a] -> [a]
: [Located (IdP (GhcPass p))]
xs, [LFieldOcc (GhcPass p)]
ys)) (([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
 -> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)]))
-> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
-> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
forall a b. (a -> b) -> a -> b
$ HsDataDefn (GhcPass p)
-> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
forall (p :: Pass).
HsDataDefn (GhcPass p)
-> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
hsDataDefnBinders HsDataDefn (GhcPass p)
defn
hsLTyClDeclBinders (Located (TyClDecl (GhcPass p))
-> Located (SrcSpanLess (Located (TyClDecl (GhcPass p))))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ (XTyClDecl nec)) = NoExtCon -> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
forall a. NoExtCon -> a
noExtCon XXTyClDecl (GhcPass p)
NoExtCon
nec
hsLTyClDeclBinders Located (TyClDecl (GhcPass p))
_ = String -> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
forall a. String -> a
panic String
"hsLTyClDeclBinders: Impossible Match"
                             -- due to #15884


-------------------
hsForeignDeclsBinders :: [LForeignDecl pass] -> [Located (IdP pass)]
-- ^ See Note [SrcSpan for binders]
hsForeignDeclsBinders :: [LForeignDecl pass] -> [Located (IdP pass)]
hsForeignDeclsBinders [LForeignDecl pass]
foreign_decls
  = [ SrcSpan -> SrcSpanLess (Located (IdP pass)) -> Located (IdP pass)
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
decl_loc SrcSpanLess (Located (IdP pass))
n
    | (LForeignDecl pass -> Located (SrcSpanLess (LForeignDecl pass))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
decl_loc (ForeignImport { fd_name = (dL->L _ n) }))
        <- [LForeignDecl pass]
foreign_decls]


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

addPatSynSelector:: LHsBind p -> [IdP p] -> [IdP p]
addPatSynSelector :: LHsBind p -> [IdP p] -> [IdP p]
addPatSynSelector LHsBind p
bind [IdP p]
sels
  | PatSynBind _ (PSB { psb_args = RecCon as }) <- LHsBind p -> SrcSpanLess (LHsBind p)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsBind p
bind
  = (RecordPatSynField (Located (IdP p)) -> IdP p)
-> [RecordPatSynField (Located (IdP p))] -> [IdP p]
forall a b. (a -> b) -> [a] -> [b]
map (Located (IdP p) -> IdP p
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (Located (IdP p) -> IdP p)
-> (RecordPatSynField (Located (IdP p)) -> Located (IdP p))
-> RecordPatSynField (Located (IdP p))
-> IdP p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RecordPatSynField (Located (IdP p)) -> Located (IdP p)
forall a. RecordPatSynField a -> a
recordPatSynSelectorId) [RecordPatSynField (Located (IdP p))]
as [IdP p] -> [IdP p] -> [IdP p]
forall a. [a] -> [a] -> [a]
++ [IdP p]
sels
  | Bool
otherwise = [IdP p]
sels

getPatSynBinds :: [(RecFlag, LHsBinds id)] -> [PatSynBind id id]
getPatSynBinds :: [(RecFlag, LHsBinds id)] -> [PatSynBind id id]
getPatSynBinds [(RecFlag, LHsBinds id)]
binds
  = [ PatSynBind id id
psb | (RecFlag
_, LHsBinds id
lbinds) <- [(RecFlag, LHsBinds id)]
binds
          , (LHsBindLR id id -> Located (SrcSpanLess (LHsBindLR id id))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ (PatSynBind _ psb)) <- LHsBinds id -> [LHsBindLR id id]
forall a. Bag a -> [a]
bagToList LHsBinds id
lbinds ]

-------------------
hsLInstDeclBinders :: LInstDecl (GhcPass p)
                   -> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
hsLInstDeclBinders :: LInstDecl (GhcPass p)
-> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
hsLInstDeclBinders (LInstDecl (GhcPass p)
-> Located (SrcSpanLess (LInstDecl (GhcPass p)))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ (ClsInstD
                             { cid_inst = ClsInstDecl
                                          { cid_datafam_insts = dfis }}))
  = (LDataFamInstDecl (GhcPass p)
 -> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)]))
-> [LDataFamInstDecl (GhcPass p)]
-> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (DataFamInstDecl (GhcPass p)
-> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
forall (p :: Pass).
DataFamInstDecl (GhcPass p)
-> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
hsDataFamInstBinders (DataFamInstDecl (GhcPass p)
 -> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)]))
-> (LDataFamInstDecl (GhcPass p) -> DataFamInstDecl (GhcPass p))
-> LDataFamInstDecl (GhcPass p)
-> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LDataFamInstDecl (GhcPass p) -> DataFamInstDecl (GhcPass p)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) [LDataFamInstDecl (GhcPass p)]
dfis
hsLInstDeclBinders (LInstDecl (GhcPass p)
-> Located (SrcSpanLess (LInstDecl (GhcPass p)))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ (DataFamInstD { dfid_inst = fi }))
  = DataFamInstDecl (GhcPass p)
-> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
forall (p :: Pass).
DataFamInstDecl (GhcPass p)
-> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
hsDataFamInstBinders DataFamInstDecl (GhcPass p)
fi
hsLInstDeclBinders (LInstDecl (GhcPass p)
-> Located (SrcSpanLess (LInstDecl (GhcPass p)))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ (TyFamInstD {})) = ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
forall a. Monoid a => a
mempty
hsLInstDeclBinders (LInstDecl (GhcPass p)
-> Located (SrcSpanLess (LInstDecl (GhcPass p)))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ (ClsInstD _ (XClsInstDecl nec)))
  = NoExtCon -> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
forall a. NoExtCon -> a
noExtCon XXClsInstDecl (GhcPass p)
NoExtCon
nec
hsLInstDeclBinders (LInstDecl (GhcPass p)
-> Located (SrcSpanLess (LInstDecl (GhcPass p)))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ (XInstDecl nec))
  = NoExtCon -> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
forall a. NoExtCon -> a
noExtCon XXInstDecl (GhcPass p)
NoExtCon
nec
hsLInstDeclBinders LInstDecl (GhcPass p)
_ = String -> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
forall a. String -> a
panic String
"hsLInstDeclBinders: Impossible Match"
                             -- due to #15884

-------------------
-- | the SrcLoc returned are for the whole declarations, not just the names
hsDataFamInstBinders :: DataFamInstDecl (GhcPass p)
                     -> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
hsDataFamInstBinders :: DataFamInstDecl (GhcPass p)
-> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
hsDataFamInstBinders (DataFamInstDecl { dfid_eqn :: forall pass.
DataFamInstDecl pass -> FamInstEqn pass (HsDataDefn pass)
dfid_eqn = HsIB { hsib_body :: forall pass thing. HsImplicitBndrs pass thing -> thing
hsib_body =
                       FamEqn { feqn_rhs :: forall pass rhs. FamEqn pass rhs -> rhs
feqn_rhs = HsDataDefn (GhcPass p)
defn }}})
  = HsDataDefn (GhcPass p)
-> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
forall (p :: Pass).
HsDataDefn (GhcPass p)
-> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
hsDataDefnBinders HsDataDefn (GhcPass p)
defn
  -- There can't be repeated symbols because only data instances have binders
hsDataFamInstBinders (DataFamInstDecl
                                    { dfid_eqn :: forall pass.
DataFamInstDecl pass -> FamInstEqn pass (HsDataDefn pass)
dfid_eqn = HsIB { hsib_body :: forall pass thing. HsImplicitBndrs pass thing -> thing
hsib_body = XFamEqn XXFamEqn (GhcPass p) (HsDataDefn (GhcPass p))
nec}})
  = NoExtCon -> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
forall a. NoExtCon -> a
noExtCon XXFamEqn (GhcPass p) (HsDataDefn (GhcPass p))
NoExtCon
nec
hsDataFamInstBinders (DataFamInstDecl (XHsImplicitBndrs XXHsImplicitBndrs
  (GhcPass p) (FamEqn (GhcPass p) (HsDataDefn (GhcPass p)))
nec))
  = NoExtCon -> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
forall a. NoExtCon -> a
noExtCon XXHsImplicitBndrs
  (GhcPass p) (FamEqn (GhcPass p) (HsDataDefn (GhcPass p)))
NoExtCon
nec

-------------------
-- | the SrcLoc returned are for the whole declarations, not just the names
hsDataDefnBinders :: HsDataDefn (GhcPass p)
                  -> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
hsDataDefnBinders :: HsDataDefn (GhcPass p)
-> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
hsDataDefnBinders (HsDataDefn { dd_cons :: forall pass. HsDataDefn pass -> [LConDecl pass]
dd_cons = [LConDecl (GhcPass p)]
cons })
  = [LConDecl (GhcPass p)]
-> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
forall (p :: Pass).
[LConDecl (GhcPass p)]
-> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
hsConDeclsBinders [LConDecl (GhcPass p)]
cons
  -- See Note [Binders in family instances]
hsDataDefnBinders (XHsDataDefn XXHsDataDefn (GhcPass p)
nec) = NoExtCon -> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
forall a. NoExtCon -> a
noExtCon XXHsDataDefn (GhcPass p)
NoExtCon
nec

-------------------
type Seen p = [LFieldOcc (GhcPass p)] -> [LFieldOcc (GhcPass p)]
                 -- Filters out ones that have already been seen

hsConDeclsBinders :: [LConDecl (GhcPass p)]
                  -> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
   -- See hsLTyClDeclBinders for what this does
   -- The function is boringly complicated because of the records
   -- And since we only have equality, we have to be a little careful
hsConDeclsBinders :: [LConDecl (GhcPass p)]
-> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
hsConDeclsBinders [LConDecl (GhcPass p)]
cons
  = Seen p
-> [LConDecl (GhcPass p)]
-> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
forall (p :: Pass).
Seen p
-> [LConDecl (GhcPass p)]
-> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
go Seen p
forall a. a -> a
id [LConDecl (GhcPass p)]
cons
  where
    go :: Seen p -> [LConDecl (GhcPass p)]
       -> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
    go :: Seen p
-> [LConDecl (GhcPass p)]
-> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
go Seen p
_ [] = ([], [])
    go Seen p
remSeen (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 :: SrcSpan
loc = LConDecl (GhcPass p) -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc LConDecl (GhcPass p)
r
        in case LConDecl (GhcPass p) -> SrcSpanLess (LConDecl (GhcPass p))
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LConDecl (GhcPass p)
r of
           -- remove only the first occurrence of any seen field in order to
           -- avoid circumventing detection of duplicate fields (#9156)
           ConDeclGADT { con_names = names, con_args = args }
             -> ((Located (IdP (GhcPass p)) -> Located (IdP (GhcPass p)))
-> [Located (IdP (GhcPass p))] -> [Located (IdP (GhcPass p))]
forall a b. (a -> b) -> [a] -> [b]
map (SrcSpan
-> SrcSpanLess (Located (IdP (GhcPass p)))
-> Located (IdP (GhcPass p))
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
loc (IdP (GhcPass p) -> Located (IdP (GhcPass p)))
-> (Located (IdP (GhcPass p)) -> IdP (GhcPass p))
-> Located (IdP (GhcPass p))
-> Located (IdP (GhcPass p))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located (IdP (GhcPass p)) -> IdP (GhcPass p)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) [Located (IdP (GhcPass p))]
names [Located (IdP (GhcPass p))]
-> [Located (IdP (GhcPass p))] -> [Located (IdP (GhcPass p))]
forall a. [a] -> [a] -> [a]
++ [Located (IdP (GhcPass p))]
ns, [LFieldOcc (GhcPass p)]
flds [LFieldOcc (GhcPass p)] -> Seen p
forall a. [a] -> [a] -> [a]
++ [LFieldOcc (GhcPass p)]
fs)
             where
                (Seen p
remSeen', [LFieldOcc (GhcPass p)]
flds) = Seen p
-> HsConDeclDetails (GhcPass p)
-> (Seen p, [LFieldOcc (GhcPass p)])
forall (p :: Pass).
Seen p
-> HsConDeclDetails (GhcPass p)
-> (Seen p, [LFieldOcc (GhcPass p)])
get_flds Seen p
remSeen HsConDeclDetails (GhcPass p)
args
                ([Located (IdP (GhcPass p))]
ns, [LFieldOcc (GhcPass p)]
fs) = Seen p
-> [LConDecl (GhcPass p)]
-> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
forall (p :: Pass).
Seen p
-> [LConDecl (GhcPass p)]
-> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
go Seen p
remSeen' [LConDecl (GhcPass p)]
rs

           ConDeclH98 { con_name = name, con_args = args }
             -> ([SrcSpan
-> SrcSpanLess (Located (IdP (GhcPass p)))
-> Located (IdP (GhcPass p))
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
loc (Located (IdP (GhcPass p))
-> SrcSpanLess (Located (IdP (GhcPass p)))
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located (IdP (GhcPass p))
name)] [Located (IdP (GhcPass p))]
-> [Located (IdP (GhcPass p))] -> [Located (IdP (GhcPass p))]
forall a. [a] -> [a] -> [a]
++ [Located (IdP (GhcPass p))]
ns, [LFieldOcc (GhcPass p)]
flds [LFieldOcc (GhcPass p)] -> Seen p
forall a. [a] -> [a] -> [a]
++ [LFieldOcc (GhcPass p)]
fs)
             where
                (Seen p
remSeen', [LFieldOcc (GhcPass p)]
flds) = Seen p
-> HsConDeclDetails (GhcPass p)
-> (Seen p, [LFieldOcc (GhcPass p)])
forall (p :: Pass).
Seen p
-> HsConDeclDetails (GhcPass p)
-> (Seen p, [LFieldOcc (GhcPass p)])
get_flds Seen p
remSeen HsConDeclDetails (GhcPass p)
args
                ([Located (IdP (GhcPass p))]
ns, [LFieldOcc (GhcPass p)]
fs) = Seen p
-> [LConDecl (GhcPass p)]
-> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
forall (p :: Pass).
Seen p
-> [LConDecl (GhcPass p)]
-> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
go Seen p
remSeen' [LConDecl (GhcPass p)]
rs

           XConDecl nec -> NoExtCon -> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
forall a. NoExtCon -> a
noExtCon XXConDecl (GhcPass p)
NoExtCon
nec

    get_flds :: Seen p -> HsConDeclDetails (GhcPass p)
             -> (Seen p, [LFieldOcc (GhcPass p)])
    get_flds :: Seen p
-> HsConDeclDetails (GhcPass p)
-> (Seen p, [LFieldOcc (GhcPass p)])
get_flds Seen p
remSeen (RecCon Located [LConDeclField (GhcPass p)]
flds)
       = (Seen p
remSeen', [LFieldOcc (GhcPass p)]
fld_names)
       where
          fld_names :: [LFieldOcc (GhcPass p)]
fld_names = Seen p
remSeen ((LConDeclField (GhcPass p) -> [LFieldOcc (GhcPass p)])
-> [LConDeclField (GhcPass p)] -> [LFieldOcc (GhcPass p)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (ConDeclField (GhcPass p) -> [LFieldOcc (GhcPass p)]
forall pass. ConDeclField pass -> [LFieldOcc pass]
cd_fld_names (ConDeclField (GhcPass p) -> [LFieldOcc (GhcPass p)])
-> (LConDeclField (GhcPass p) -> ConDeclField (GhcPass p))
-> LConDeclField (GhcPass p)
-> [LFieldOcc (GhcPass p)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LConDeclField (GhcPass p) -> ConDeclField (GhcPass p)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) (Located [LConDeclField (GhcPass p)]
-> SrcSpanLess (Located [LConDeclField (GhcPass p)])
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located [LConDeclField (GhcPass p)]
flds))
          remSeen' :: Seen p
remSeen' = (Seen p -> Seen p -> Seen p) -> Seen p -> [Seen p] -> Seen p
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Seen p -> Seen p -> Seen p
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) Seen p
remSeen
                               [(LFieldOcc (GhcPass p) -> LFieldOcc (GhcPass p) -> Bool)
-> LFieldOcc (GhcPass p) -> Seen p
forall a. (a -> a -> Bool) -> a -> [a] -> [a]
deleteBy (RdrName -> RdrName -> Bool
forall a. Eq a => a -> a -> Bool
(==) (RdrName -> RdrName -> Bool)
-> (LFieldOcc (GhcPass p) -> RdrName)
-> LFieldOcc (GhcPass p)
-> LFieldOcc (GhcPass p)
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Located RdrName -> RdrName
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (Located RdrName -> RdrName)
-> (LFieldOcc (GhcPass p) -> Located RdrName)
-> LFieldOcc (GhcPass p)
-> RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldOcc (GhcPass p) -> Located RdrName
forall pass. FieldOcc pass -> Located RdrName
rdrNameFieldOcc (FieldOcc (GhcPass p) -> Located RdrName)
-> (LFieldOcc (GhcPass p) -> FieldOcc (GhcPass p))
-> LFieldOcc (GhcPass p)
-> Located RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LFieldOcc (GhcPass p) -> FieldOcc (GhcPass p)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) LFieldOcc (GhcPass p)
v
                               | LFieldOcc (GhcPass p)
v <- [LFieldOcc (GhcPass p)]
fld_names]
    get_flds Seen p
remSeen HsConDeclDetails (GhcPass p)
_
       = (Seen p
remSeen, [])

{-

Note [SrcSpan for binders]
~~~~~~~~~~~~~~~~~~~~~~~~~~
When extracting the (Located RdrNme) 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) (Located (body (GhcPass idR)))]
                -> [(SrcSpan, [Name])]
lStmtsImplicits :: [LStmtLR GhcRn (GhcPass idR) (Located (body (GhcPass idR)))]
-> [(SrcSpan, [Name])]
lStmtsImplicits = [LStmtLR GhcRn (GhcPass idR) (Located (body (GhcPass idR)))]
-> [(SrcSpan, [Name])]
forall (idR :: Pass) (body :: * -> *).
[LStmtLR GhcRn (GhcPass idR) (Located (body (GhcPass idR)))]
-> [(SrcSpan, [Name])]
hs_lstmts
  where
    hs_lstmts :: [LStmtLR GhcRn (GhcPass idR) (Located (body (GhcPass idR)))]
              -> [(SrcSpan, [Name])]
    hs_lstmts :: [LStmtLR GhcRn (GhcPass idR) (Located (body (GhcPass idR)))]
-> [(SrcSpan, [Name])]
hs_lstmts = (LStmtLR GhcRn (GhcPass idR) (Located (body (GhcPass idR)))
 -> [(SrcSpan, [Name])])
-> [LStmtLR GhcRn (GhcPass idR) (Located (body (GhcPass idR)))]
-> [(SrcSpan, [Name])]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (StmtLR GhcRn (GhcPass idR) (Located (body (GhcPass idR)))
-> [(SrcSpan, [Name])]
forall (idR :: Pass) (body :: * -> *).
StmtLR GhcRn (GhcPass idR) (Located (body (GhcPass idR)))
-> [(SrcSpan, [Name])]
hs_stmt (StmtLR GhcRn (GhcPass idR) (Located (body (GhcPass idR)))
 -> [(SrcSpan, [Name])])
-> (LStmtLR GhcRn (GhcPass idR) (Located (body (GhcPass idR)))
    -> StmtLR GhcRn (GhcPass idR) (Located (body (GhcPass idR))))
-> LStmtLR GhcRn (GhcPass idR) (Located (body (GhcPass idR)))
-> [(SrcSpan, [Name])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LStmtLR GhcRn (GhcPass idR) (Located (body (GhcPass idR)))
-> StmtLR GhcRn (GhcPass idR) (Located (body (GhcPass idR)))
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc)

    hs_stmt :: StmtLR GhcRn (GhcPass idR) (Located (body (GhcPass idR)))
            -> [(SrcSpan, [Name])]
    hs_stmt :: StmtLR GhcRn (GhcPass idR) (Located (body (GhcPass idR)))
-> [(SrcSpan, [Name])]
hs_stmt (BindStmt XBindStmt GhcRn (GhcPass idR) (Located (body (GhcPass idR)))
_ LPat GhcRn
pat Located (body (GhcPass idR))
_ SyntaxExpr (GhcPass idR)
_ SyntaxExpr (GhcPass idR)
_) = LPat GhcRn -> [(SrcSpan, [Name])]
lPatImplicits LPat GhcRn
pat
    hs_stmt (ApplicativeStmt XApplicativeStmt GhcRn (GhcPass idR) (Located (body (GhcPass idR)))
_ [(SyntaxExpr (GhcPass idR), ApplicativeArg GhcRn)]
args Maybe (SyntaxExpr (GhcPass idR))
_) = ((SyntaxExpr (GhcPass idR), ApplicativeArg GhcRn)
 -> [(SrcSpan, [Name])])
-> [(SyntaxExpr (GhcPass idR), ApplicativeArg GhcRn)]
-> [(SrcSpan, [Name])]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (SyntaxExpr (GhcPass idR), ApplicativeArg GhcRn)
-> [(SrcSpan, [Name])]
forall a. (a, ApplicativeArg GhcRn) -> [(SrcSpan, [Name])]
do_arg [(SyntaxExpr (GhcPass idR), ApplicativeArg GhcRn)]
args
      where do_arg :: (a, ApplicativeArg GhcRn) -> [(SrcSpan, [Name])]
do_arg (a
_, ApplicativeArgOne { app_arg_pattern :: forall idL. ApplicativeArg idL -> LPat idL
app_arg_pattern = LPat GhcRn
pat }) = LPat GhcRn -> [(SrcSpan, [Name])]
lPatImplicits LPat GhcRn
pat
            do_arg (a
_, ApplicativeArgMany { app_stmts :: forall idL. ApplicativeArg idL -> [ExprLStmt idL]
app_stmts = [ExprLStmt GhcRn]
stmts }) = [ExprLStmt GhcRn] -> [(SrcSpan, [Name])]
forall (idR :: Pass) (body :: * -> *).
[LStmtLR GhcRn (GhcPass idR) (Located (body (GhcPass idR)))]
-> [(SrcSpan, [Name])]
hs_lstmts [ExprLStmt GhcRn]
stmts
            do_arg (a
_, XApplicativeArg XXApplicativeArg GhcRn
nec) = NoExtCon -> [(SrcSpan, [Name])]
forall a. NoExtCon -> a
noExtCon XXApplicativeArg GhcRn
NoExtCon
nec
    hs_stmt (LetStmt XLetStmt GhcRn (GhcPass idR) (Located (body (GhcPass idR)))
_ LHsLocalBindsLR GhcRn (GhcPass idR)
binds)     = HsLocalBindsLR GhcRn (GhcPass idR) -> [(SrcSpan, [Name])]
forall (idR :: Pass).
HsLocalBindsLR GhcRn (GhcPass idR) -> [(SrcSpan, [Name])]
hs_local_binds (LHsLocalBindsLR GhcRn (GhcPass idR)
-> SrcSpanLess (LHsLocalBindsLR GhcRn (GhcPass idR))
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsLocalBindsLR GhcRn (GhcPass idR)
binds)
    hs_stmt (BodyStmt {})         = []
    hs_stmt (LastStmt {})         = []
    hs_stmt (ParStmt XParStmt GhcRn (GhcPass idR) (Located (body (GhcPass idR)))
_ [ParStmtBlock GhcRn (GhcPass idR)]
xs HsExpr (GhcPass idR)
_ SyntaxExpr (GhcPass idR)
_)    = [ExprLStmt GhcRn] -> [(SrcSpan, [Name])]
forall (idR :: Pass) (body :: * -> *).
[LStmtLR GhcRn (GhcPass idR) (Located (body (GhcPass idR)))]
-> [(SrcSpan, [Name])]
hs_lstmts [ExprLStmt GhcRn
s | ParStmtBlock XParStmtBlock GhcRn (GhcPass idR)
_ [ExprLStmt GhcRn]
ss [IdP (GhcPass idR)]
_ SyntaxExpr (GhcPass idR)
_ <- [ParStmtBlock GhcRn (GhcPass idR)]
xs
                                                , ExprLStmt GhcRn
s <- [ExprLStmt GhcRn]
ss]
    hs_stmt (TransStmt { trS_stmts :: forall idL idR body. StmtLR idL idR body -> [ExprLStmt idL]
trS_stmts = [ExprLStmt GhcRn]
stmts }) = [ExprLStmt GhcRn] -> [(SrcSpan, [Name])]
forall (idR :: Pass) (body :: * -> *).
[LStmtLR GhcRn (GhcPass idR) (Located (body (GhcPass idR)))]
-> [(SrcSpan, [Name])]
hs_lstmts [ExprLStmt GhcRn]
stmts
    hs_stmt (RecStmt { recS_stmts :: forall idL idR body. StmtLR idL idR body -> [LStmtLR idL idR body]
recS_stmts = [LStmtLR GhcRn (GhcPass idR) (Located (body (GhcPass idR)))]
ss })     = [LStmtLR GhcRn (GhcPass idR) (Located (body (GhcPass idR)))]
-> [(SrcSpan, [Name])]
forall (idR :: Pass) (body :: * -> *).
[LStmtLR GhcRn (GhcPass idR) (Located (body (GhcPass idR)))]
-> [(SrcSpan, [Name])]
hs_lstmts [LStmtLR GhcRn (GhcPass idR) (Located (body (GhcPass idR)))]
ss
    hs_stmt (XStmtLR XXStmtLR GhcRn (GhcPass idR) (Located (body (GhcPass idR)))
nec)         = NoExtCon -> [(SrcSpan, [Name])]
forall a. NoExtCon -> a
noExtCon XXStmtLR GhcRn (GhcPass idR) (Located (body (GhcPass idR)))
NoExtCon
nec

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

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

lhsBindsImplicits :: LHsBindsLR GhcRn idR -> [(SrcSpan, [Name])]
lhsBindsImplicits :: LHsBindsLR GhcRn idR -> [(SrcSpan, [Name])]
lhsBindsImplicits = ([(SrcSpan, [Name])] -> [(SrcSpan, [Name])] -> [(SrcSpan, [Name])])
-> (LHsBindLR GhcRn idR -> [(SrcSpan, [Name])])
-> [(SrcSpan, [Name])]
-> LHsBindsLR GhcRn 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 GhcRn idR -> [(SrcSpan, [Name])]
forall idR. HsBindLR GhcRn idR -> [(SrcSpan, [Name])]
lhs_bind (HsBindLR GhcRn idR -> [(SrcSpan, [Name])])
-> (LHsBindLR GhcRn idR -> HsBindLR GhcRn idR)
-> LHsBindLR GhcRn idR
-> [(SrcSpan, [Name])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsBindLR GhcRn idR -> HsBindLR GhcRn idR
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) []
  where
    lhs_bind :: HsBindLR GhcRn idR -> [(SrcSpan, [Name])]
lhs_bind (PatBind { pat_lhs :: forall idL idR. HsBindLR idL idR -> LPat idL
pat_lhs = LPat GhcRn
lpat }) = LPat GhcRn -> [(SrcSpan, [Name])]
lPatImplicits LPat GhcRn
lpat
    lhs_bind HsBindLR GhcRn idR
_ = []

lPatImplicits :: LPat GhcRn -> [(SrcSpan, [Name])]
lPatImplicits :: LPat GhcRn -> [(SrcSpan, [Name])]
lPatImplicits = Located (Pat GhcRn) -> [(SrcSpan, [Name])]
LPat GhcRn -> [(SrcSpan, [Name])]
hs_lpat
  where
    hs_lpat :: Located (Pat GhcRn) -> [(SrcSpan, [Name])]
hs_lpat Located (Pat GhcRn)
lpat = Pat GhcRn -> [(SrcSpan, [Name])]
hs_pat (Located (Pat GhcRn) -> SrcSpanLess (Located (Pat GhcRn))
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located (Pat GhcRn)
lpat)

    hs_lpats :: [Located (Pat GhcRn)] -> [(SrcSpan, [Name])]
hs_lpats = (Located (Pat GhcRn) -> [(SrcSpan, [Name])] -> [(SrcSpan, [Name])])
-> [(SrcSpan, [Name])]
-> [Located (Pat GhcRn)]
-> [(SrcSpan, [Name])]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Located (Pat GhcRn)
pat [(SrcSpan, [Name])]
rest -> Located (Pat GhcRn) -> [(SrcSpan, [Name])]
hs_lpat Located (Pat GhcRn)
pat [(SrcSpan, [Name])] -> [(SrcSpan, [Name])] -> [(SrcSpan, [Name])]
forall a. [a] -> [a] -> [a]
++ [(SrcSpan, [Name])]
rest) []

    hs_pat :: Pat GhcRn -> [(SrcSpan, [Name])]
hs_pat (LazyPat XLazyPat GhcRn
_ LPat GhcRn
pat)      = Located (Pat GhcRn) -> [(SrcSpan, [Name])]
hs_lpat Located (Pat GhcRn)
LPat GhcRn
pat
    hs_pat (BangPat XBangPat GhcRn
_ LPat GhcRn
pat)      = Located (Pat GhcRn) -> [(SrcSpan, [Name])]
hs_lpat Located (Pat GhcRn)
LPat GhcRn
pat
    hs_pat (AsPat XAsPat GhcRn
_ Located (IdP GhcRn)
_ LPat GhcRn
pat)      = Located (Pat GhcRn) -> [(SrcSpan, [Name])]
hs_lpat Located (Pat GhcRn)
LPat GhcRn
pat
    hs_pat (ViewPat XViewPat GhcRn
_ LHsExpr GhcRn
_ LPat GhcRn
pat)    = Located (Pat GhcRn) -> [(SrcSpan, [Name])]
hs_lpat Located (Pat GhcRn)
LPat GhcRn
pat
    hs_pat (ParPat XParPat GhcRn
_ LPat GhcRn
pat)       = Located (Pat GhcRn) -> [(SrcSpan, [Name])]
hs_lpat Located (Pat GhcRn)
LPat GhcRn
pat
    hs_pat (ListPat XListPat GhcRn
_ [LPat GhcRn]
pats)     = [Located (Pat GhcRn)] -> [(SrcSpan, [Name])]
hs_lpats [Located (Pat GhcRn)]
[LPat GhcRn]
pats
    hs_pat (TuplePat XTuplePat GhcRn
_ [LPat GhcRn]
pats Boxity
_)  = [Located (Pat GhcRn)] -> [(SrcSpan, [Name])]
hs_lpats [Located (Pat GhcRn)]
[LPat GhcRn]
pats

    hs_pat (SigPat XSigPat GhcRn
_ LPat GhcRn
pat LHsSigWcType (NoGhcTc GhcRn)
_)     = Located (Pat GhcRn) -> [(SrcSpan, [Name])]
hs_lpat Located (Pat GhcRn)
LPat GhcRn
pat
    hs_pat (CoPat XCoPat GhcRn
_ HsWrapper
_ Pat GhcRn
pat Type
_)    = Pat GhcRn -> [(SrcSpan, [Name])]
hs_pat Pat GhcRn
pat

    hs_pat (ConPatIn Located (IdP GhcRn)
n HsConPatDetails GhcRn
ps)           = Located Name -> HsConPatDetails GhcRn -> [(SrcSpan, [Name])]
details Located Name
Located (IdP GhcRn)
n HsConPatDetails GhcRn
ps
    hs_pat (ConPatOut {pat_con :: forall p. Pat p -> Located ConLike
pat_con=Located ConLike
con, pat_args :: forall p. Pat p -> HsConPatDetails p
pat_args=HsConPatDetails GhcRn
ps}) = Located Name -> HsConPatDetails GhcRn -> [(SrcSpan, [Name])]
details ((ConLike -> Name) -> Located ConLike -> Located Name
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ConLike -> Name
conLikeName Located ConLike
con) HsConPatDetails GhcRn
ps

    hs_pat Pat GhcRn
_ = []

    details :: Located Name -> HsConPatDetails GhcRn -> [(SrcSpan, [Name])]
    details :: Located Name -> HsConPatDetails GhcRn -> [(SrcSpan, [Name])]
details Located Name
_ (PrefixCon [LPat GhcRn]
ps)   = [Located (Pat GhcRn)] -> [(SrcSpan, [Name])]
hs_lpats [Located (Pat GhcRn)]
[LPat GhcRn]
ps
    details Located Name
n (RecCon HsRecFields GhcRn (LPat GhcRn)
fs)      =
      [(SrcSpan
err_loc, [LPat GhcRn] -> [IdP GhcRn]
forall (p :: Pass). [LPat (GhcPass p)] -> [IdP (GhcPass p)]
collectPatsBinders [Located (Pat GhcRn)]
[LPat GhcRn]
implicit_pats) | Just{} <- [HsRecFields GhcRn (Located (Pat GhcRn)) -> Maybe (Located Int)
forall p arg. HsRecFields p arg -> Maybe (Located Int)
rec_dotdot HsRecFields GhcRn (Located (Pat GhcRn))
HsRecFields GhcRn (LPat GhcRn)
fs] ]
        [(SrcSpan, [Name])] -> [(SrcSpan, [Name])] -> [(SrcSpan, [Name])]
forall a. [a] -> [a] -> [a]
++ [Located (Pat GhcRn)] -> [(SrcSpan, [Name])]
hs_lpats [Located (Pat GhcRn)]
explicit_pats

      where implicit_pats :: [Located (Pat GhcRn)]
implicit_pats = (LHsRecField GhcRn (Located (Pat GhcRn)) -> Located (Pat GhcRn))
-> [LHsRecField GhcRn (Located (Pat GhcRn))]
-> [Located (Pat GhcRn)]
forall a b. (a -> b) -> [a] -> [b]
map (HsRecField' (FieldOcc GhcRn) (Located (Pat GhcRn))
-> Located (Pat GhcRn)
forall id arg. HsRecField' id arg -> arg
hsRecFieldArg (HsRecField' (FieldOcc GhcRn) (Located (Pat GhcRn))
 -> Located (Pat GhcRn))
-> (LHsRecField GhcRn (Located (Pat GhcRn))
    -> HsRecField' (FieldOcc GhcRn) (Located (Pat GhcRn)))
-> LHsRecField GhcRn (Located (Pat GhcRn))
-> Located (Pat GhcRn)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsRecField GhcRn (Located (Pat GhcRn))
-> HsRecField' (FieldOcc GhcRn) (Located (Pat GhcRn))
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) [LHsRecField GhcRn (Located (Pat GhcRn))]
implicit
            explicit_pats :: [Located (Pat GhcRn)]
explicit_pats = (LHsRecField GhcRn (Located (Pat GhcRn)) -> Located (Pat GhcRn))
-> [LHsRecField GhcRn (Located (Pat GhcRn))]
-> [Located (Pat GhcRn)]
forall a b. (a -> b) -> [a] -> [b]
map (HsRecField' (FieldOcc GhcRn) (Located (Pat GhcRn))
-> Located (Pat GhcRn)
forall id arg. HsRecField' id arg -> arg
hsRecFieldArg (HsRecField' (FieldOcc GhcRn) (Located (Pat GhcRn))
 -> Located (Pat GhcRn))
-> (LHsRecField GhcRn (Located (Pat GhcRn))
    -> HsRecField' (FieldOcc GhcRn) (Located (Pat GhcRn)))
-> LHsRecField GhcRn (Located (Pat GhcRn))
-> Located (Pat GhcRn)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsRecField GhcRn (Located (Pat GhcRn))
-> HsRecField' (FieldOcc GhcRn) (Located (Pat GhcRn))
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) [LHsRecField GhcRn (Located (Pat GhcRn))]
explicit


            ([LHsRecField GhcRn (Located (Pat GhcRn))]
explicit, [LHsRecField GhcRn (Located (Pat GhcRn))]
implicit) = [Either
   (LHsRecField GhcRn (Located (Pat GhcRn)))
   (LHsRecField GhcRn (Located (Pat GhcRn)))]
-> ([LHsRecField GhcRn (Located (Pat GhcRn))],
    [LHsRecField GhcRn (Located (Pat GhcRn))])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [if Bool
pat_explicit then LHsRecField GhcRn (Located (Pat GhcRn))
-> Either
     (LHsRecField GhcRn (Located (Pat GhcRn)))
     (LHsRecField GhcRn (Located (Pat GhcRn)))
forall a b. a -> Either a b
Left LHsRecField GhcRn (Located (Pat GhcRn))
fld else LHsRecField GhcRn (Located (Pat GhcRn))
-> Either
     (LHsRecField GhcRn (Located (Pat GhcRn)))
     (LHsRecField GhcRn (Located (Pat GhcRn)))
forall a b. b -> Either a b
Right LHsRecField GhcRn (Located (Pat GhcRn))
fld
                                                    | (Int
i, LHsRecField GhcRn (Located (Pat GhcRn))
fld) <- [Int
0..] [Int]
-> [LHsRecField GhcRn (Located (Pat GhcRn))]
-> [(Int, LHsRecField GhcRn (Located (Pat GhcRn)))]
forall a b. [a] -> [b] -> [(a, b)]
`zip` HsRecFields GhcRn (Located (Pat GhcRn))
-> [LHsRecField GhcRn (Located (Pat GhcRn))]
forall p arg. HsRecFields p arg -> [LHsRecField p arg]
rec_flds HsRecFields GhcRn (Located (Pat GhcRn))
HsRecFields GhcRn (LPat GhcRn)
fs
                                                    ,  let  pat_explicit :: Bool
pat_explicit =
                                                              Bool -> (Located Int -> Bool) -> Maybe (Located Int) -> 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) -> (Located Int -> Int) -> Located Int -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located Int -> Int
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc)
                                                                         (HsRecFields GhcRn (Located (Pat GhcRn)) -> Maybe (Located Int)
forall p arg. HsRecFields p arg -> Maybe (Located Int)
rec_dotdot HsRecFields GhcRn (Located (Pat GhcRn))
HsRecFields GhcRn (LPat GhcRn)
fs)]
            err_loc :: SrcSpan
err_loc = SrcSpan
-> (Located Int -> SrcSpan) -> Maybe (Located Int) -> SrcSpan
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Located Name -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc Located Name
n) Located Int -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc (HsRecFields GhcRn (Located (Pat GhcRn)) -> Maybe (Located Int)
forall p arg. HsRecFields p arg -> Maybe (Located Int)
rec_dotdot HsRecFields GhcRn (Located (Pat GhcRn))
HsRecFields GhcRn (LPat GhcRn)
fs)

    details Located Name
_ (InfixCon LPat GhcRn
p1 LPat GhcRn
p2) = Located (Pat GhcRn) -> [(SrcSpan, [Name])]
hs_lpat Located (Pat GhcRn)
LPat GhcRn
p1 [(SrcSpan, [Name])] -> [(SrcSpan, [Name])] -> [(SrcSpan, [Name])]
forall a. [a] -> [a] -> [a]
++ Located (Pat GhcRn) -> [(SrcSpan, [Name])]
hs_lpat Located (Pat GhcRn)
LPat GhcRn
p2