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

{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}

module HsUtils(
  -- 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,

  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, mk_easy_FunBind, 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, userHsTyVarBndrs, userHsLTyVarBndrs,
  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
  mkHsSpliceTy, mkHsSpliceE, mkHsSpliceTE, mkUntypedSplice,
  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 HsDecls
import HsBinds
import HsExpr
import HsPat
import HsTypes
import HsLit
import PlaceHolder
import HsExtension

import TcEvidence
import RdrName
import Var
import TyCoRep
import Type   ( tyConArgFlags )
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.
-}

mkHsPar :: LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
mkHsPar :: LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
mkHsPar e :: 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)
NoExt
noExt 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 ctxt :: HsMatchContext (NameOrRdrName (IdP (GhcPass p)))
ctxt pats :: [LPat (GhcPass p)]
pats rhs :: 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)))
NoExt
noExt, 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
                (pat :: LPat (GhcPass p)
pat:_) -> SrcSpan -> SrcSpan -> SrcSpan
combineSrcSpans (LPat (GhcPass p) -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc 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 loc :: SrcSpan
loc _)
  = 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)))
NoExt
noExt (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 loc :: SrcSpan
loc rhs :: 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)))
NoExt
noExt [] Located (body (GhcPass p))
rhs)]

mkMatchGroup :: (XMG name (Located (body name)) ~ NoExt)
             => 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
origin matches :: [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))
NoExt
noExt
                                 , 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 ms :: [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 e1 :: LHsExpr (GhcPass id)
e1 e2 :: 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)
NoExt
noExt 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 e :: LHsExpr (GhcPass id)
e t :: 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)
NoExt
noExt 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)) ~ NoExt) =>
  [LPat (GhcPass p)] -> LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
mkHsLam :: [LPat (GhcPass p)] -> LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
mkHsLam pats :: [LPat (GhcPass p)]
pats body :: 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)
NoExt
noExt 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)) ~ NoExt) =>
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 [LPat (GhcPass p)]
pats' LHsExpr (GhcPass p)
body]
    pats' :: [LPat (GhcPass p)]
pats' = (LPat (GhcPass p) -> LPat (GhcPass p))
-> [LPat (GhcPass p)] -> [LPat (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) [LPat (GhcPass p)]
pats

mkHsLams :: [TyVar] -> [EvVar] -> LHsExpr GhcTc -> LHsExpr GhcTc
mkHsLams :: [TyVar] -> [TyVar] -> LHsExpr GhcTc -> LHsExpr GhcTc
mkHsLams tyvars :: [TyVar]
tyvars dicts :: [TyVar]
dicts expr :: 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 pat :: LPat (GhcPass p)
pat expr :: 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 fun_id :: IdP (GhcPass id)
fun_id tys :: [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)
NoExt
noExt (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 fun_id :: IdP (GhcPass id)
fun_id tys :: [Type]
tys xs :: [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 ---------
mkLHsPar :: LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
-- 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 le :: LHsExpr (GhcPass id)
le@(LHsExpr (GhcPass id)
-> Located (SrcSpanLess (LHsExpr (GhcPass id)))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L loc :: SrcSpan
loc e :: 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)
NoExt
noExt 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 (LPat (GhcPass name)))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L loc :: SrcSpan
loc p :: SrcSpanLess (LPat (GhcPass name))
p)
  | PprPrec -> LPat (GhcPass name) -> Bool
forall p. PprPrec -> Pat p -> Bool
patNeedsParens PprPrec
appPrec SrcSpanLess (LPat (GhcPass name))
LPat (GhcPass name)
p = SrcSpan -> SrcSpanLess (LPat (GhcPass name)) -> LPat (GhcPass name)
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
loc (XParPat (GhcPass name)
-> LPat (GhcPass name) -> LPat (GhcPass name)
forall p. XParPat p -> LPat p -> LPat p
ParPat XParPat (GhcPass name)
NoExt
noExt 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 p :: LPat (GhcPass name)
p = SrcSpanLess (LPat (GhcPass name)) -> LPat (GhcPass name)
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (XParPat (GhcPass name)
-> LPat (GhcPass name) -> LPat (GhcPass name)
forall p. XParPat p -> LPat p -> LPat p
ParPat XParPat (GhcPass name)
NoExt
noExt 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))) ~ NoExt)
           => 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     i :: IntegralLit
i  = XOverLit GhcPs -> OverLitVal -> HsExpr GhcPs -> HsOverLit GhcPs
forall p. XOverLit p -> OverLitVal -> HsExpr p -> HsOverLit p
OverLit XOverLit GhcPs
NoExt
noExt (IntegralLit -> OverLitVal
HsIntegral       IntegralLit
i) HsExpr GhcPs
forall (p :: Pass). HsExpr (GhcPass p)
noExpr
mkHsFractional :: FractionalLit -> HsOverLit GhcPs
mkHsFractional   f :: FractionalLit
f  = XOverLit GhcPs -> OverLitVal -> HsExpr GhcPs -> HsOverLit GhcPs
forall p. XOverLit p -> OverLitVal -> HsExpr p -> HsOverLit p
OverLit XOverLit GhcPs
NoExt
noExt (FractionalLit -> OverLitVal
HsFractional     FractionalLit
f) HsExpr GhcPs
forall (p :: Pass). HsExpr (GhcPass p)
noExpr
mkHsIsString :: SourceText -> FastString -> HsOverLit GhcPs
mkHsIsString src :: SourceText
src s :: FastString
s  = XOverLit GhcPs -> OverLitVal -> HsExpr GhcPs -> HsOverLit GhcPs
forall p. XOverLit p -> OverLitVal -> HsExpr p -> HsOverLit p
OverLit XOverLit GhcPs
NoExt
noExt (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 ctxt :: HsStmtContext Name
ctxt stmts :: [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
NoExt
noExt 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 ctxt :: HsStmtContext Name
ctxt stmts :: [ExprLStmt GhcPs]
stmts expr :: 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 c :: LHsExpr (GhcPass p)
c a :: LHsExpr (GhcPass p)
a b :: 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)
NoExt
noExt (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

mkNPat :: Located (HsOverLit GhcPs) -> Maybe (SyntaxExpr GhcPs) -> Pat GhcPs
mkNPat lit :: Located (HsOverLit GhcPs)
lit neg :: 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
-> LPat p
NPat XNPat GhcPs
NoExt
noExt 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 id :: Located RdrName
id lit :: 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
-> LPat p
NPlusKPat XNPlusKPat GhcPs
NoExt
noExt 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)
NoExt
noExt
                           , trS_form :: TransForm
trS_form = String -> TransForm
forall a. String -> a
panic "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    ss :: [ExprLStmt GhcPs]
ss u :: 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  ss :: [ExprLStmt GhcPs]
ss u :: LHsExpr GhcPs
u b :: 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   ss :: [ExprLStmt GhcPs]
ss u :: 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 ss :: [ExprLStmt GhcPs]
ss b :: LHsExpr GhcPs
b u :: 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 body :: 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)))
NoExt
noExt 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 body :: 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))
NoExt
noExt 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 pat :: LPat (GhcPass idL)
pat body :: 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)))
NoExt
noExt 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 pat :: LPat GhcTc
pat body :: 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' tyVal :: 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
NoExt
noExt
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
NoExt
noExt
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 stmts :: [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 e1 :: LHsExpr GhcPs
e1 op :: IdP GhcPs
op e2 :: 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
NoExt
noExt 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
NoExt
noExt (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 "splice"))

mkUntypedSplice :: SpliceDecoration -> LHsExpr GhcPs -> HsSplice GhcPs
mkUntypedSplice :: SpliceDecoration -> LHsExpr GhcPs -> HsSplice GhcPs
mkUntypedSplice hasParen :: SpliceDecoration
hasParen e :: 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
NoExt
noExt SpliceDecoration
hasParen RdrName
IdP GhcPs
unqualSplice LHsExpr GhcPs
e

mkHsSpliceE :: SpliceDecoration -> LHsExpr GhcPs -> HsExpr GhcPs
mkHsSpliceE :: SpliceDecoration -> LHsExpr GhcPs -> HsExpr GhcPs
mkHsSpliceE hasParen :: SpliceDecoration
hasParen e :: LHsExpr GhcPs
e = XSpliceE GhcPs -> HsSplice GhcPs -> HsExpr GhcPs
forall p. XSpliceE p -> HsSplice p -> HsExpr p
HsSpliceE XSpliceE GhcPs
NoExt
noExt (SpliceDecoration -> LHsExpr GhcPs -> HsSplice GhcPs
mkUntypedSplice SpliceDecoration
hasParen LHsExpr GhcPs
e)

mkHsSpliceTE :: SpliceDecoration -> LHsExpr GhcPs -> HsExpr GhcPs
mkHsSpliceTE :: SpliceDecoration -> LHsExpr GhcPs -> HsExpr GhcPs
mkHsSpliceTE hasParen :: SpliceDecoration
hasParen e :: LHsExpr GhcPs
e
  = XSpliceE GhcPs -> HsSplice GhcPs -> HsExpr GhcPs
forall p. XSpliceE p -> HsSplice p -> HsExpr p
HsSpliceE XSpliceE GhcPs
NoExt
noExt (XTypedSplice GhcPs
-> SpliceDecoration -> IdP GhcPs -> LHsExpr GhcPs -> HsSplice GhcPs
forall id.
XTypedSplice id
-> SpliceDecoration -> IdP id -> LHsExpr id -> HsSplice id
HsTypedSplice XTypedSplice GhcPs
NoExt
noExt SpliceDecoration
hasParen RdrName
IdP GhcPs
unqualSplice LHsExpr GhcPs
e)

mkHsSpliceTy :: SpliceDecoration -> LHsExpr GhcPs -> HsType GhcPs
mkHsSpliceTy :: SpliceDecoration -> LHsExpr GhcPs -> HsType GhcPs
mkHsSpliceTy hasParen :: SpliceDecoration
hasParen e :: LHsExpr GhcPs
e = XSpliceTy GhcPs -> HsSplice GhcPs -> HsType GhcPs
forall pass. XSpliceTy pass -> HsSplice pass -> HsType pass
HsSpliceTy XSpliceTy GhcPs
NoExt
noExt
                      (XUntypedSplice GhcPs
-> SpliceDecoration -> IdP GhcPs -> LHsExpr GhcPs -> HsSplice GhcPs
forall id.
XUntypedSplice id
-> SpliceDecoration -> IdP id -> LHsExpr id -> HsSplice id
HsUntypedSplice XUntypedSplice GhcPs
NoExt
noExt SpliceDecoration
hasParen RdrName
IdP GhcPs
unqualSplice LHsExpr GhcPs
e)

mkHsQuasiQuote :: RdrName -> SrcSpan -> FastString -> HsSplice GhcPs
mkHsQuasiQuote :: RdrName -> SrcSpan -> FastString -> HsSplice GhcPs
mkHsQuasiQuote quoter :: RdrName
quoter span :: SrcSpan
span quote :: 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
NoExt
noExt 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 "quasiquote"))
                -- A name (uniquified later) to
                -- identify the quasi-quote

mkHsString :: String -> HsLit (GhcPass p)
mkHsString :: String -> HsLit (GhcPass p)
mkHsString s :: 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 fs :: FastString
fs
  = XHsStringPrim (GhcPass p) -> ByteString -> HsLit (GhcPass p)
forall x. XHsStringPrim x -> ByteString -> HsLit x
HsStringPrim SourceText
XHsStringPrim (GhcPass p)
NoSourceText (FastString -> ByteString
fastStringToByteString FastString
fs)

-------------
userHsLTyVarBndrs :: SrcSpan -> [Located (IdP (GhcPass p))]
                  -> [LHsTyVarBndr (GhcPass p)]
-- Caller sets location
userHsLTyVarBndrs :: SrcSpan
-> [Located (IdP (GhcPass p))] -> [LHsTyVarBndr (GhcPass p)]
userHsLTyVarBndrs loc :: SrcSpan
loc bndrs :: [Located (IdP (GhcPass p))]
bndrs = [ SrcSpan
-> SrcSpanLess (LHsTyVarBndr (GhcPass p))
-> LHsTyVarBndr (GhcPass p)
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
loc (XUserTyVar (GhcPass p)
-> Located (IdP (GhcPass p)) -> HsTyVarBndr (GhcPass p)
forall pass.
XUserTyVar pass -> Located (IdP pass) -> HsTyVarBndr pass
UserTyVar XUserTyVar (GhcPass p)
NoExt
noExt Located (IdP (GhcPass p))
v) | Located (IdP (GhcPass p))
v <- [Located (IdP (GhcPass p))]
bndrs ]

userHsTyVarBndrs :: SrcSpan -> [IdP (GhcPass p)] -> [LHsTyVarBndr (GhcPass p)]
-- Caller sets location
userHsTyVarBndrs :: SrcSpan -> [IdP (GhcPass p)] -> [LHsTyVarBndr (GhcPass p)]
userHsTyVarBndrs loc :: SrcSpan
loc bndrs :: [IdP (GhcPass p)]
bndrs = [ SrcSpan
-> SrcSpanLess (LHsTyVarBndr (GhcPass p))
-> LHsTyVarBndr (GhcPass p)
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
loc (XUserTyVar (GhcPass p)
-> Located (IdP (GhcPass p)) -> HsTyVarBndr (GhcPass p)
forall pass.
XUserTyVar pass -> Located (IdP pass) -> HsTyVarBndr pass
UserTyVar XUserTyVar (GhcPass p)
NoExt
noExt (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)))
IdP (GhcPass p)
v))
                             | IdP (GhcPass p)
v <- [IdP (GhcPass p)]
bndrs ]


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

nlHsVar :: IdP (GhcPass id) -> LHsExpr (GhcPass id)
nlHsVar :: IdP (GhcPass id) -> LHsExpr (GhcPass id)
nlHsVar n :: 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)
NoExt
noExt (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 con :: 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
NoExt
noExt (DataCon -> ConLike
RealDataCon DataCon
con))

nlHsLit :: HsLit (GhcPass p) -> LHsExpr (GhcPass p)
nlHsLit :: HsLit (GhcPass p) -> LHsExpr (GhcPass p)
nlHsLit n :: 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)
NoExt
noExt HsLit (GhcPass p)
n)

nlHsIntLit :: Integer -> LHsExpr (GhcPass p)
nlHsIntLit :: Integer -> LHsExpr (GhcPass p)
nlHsIntLit n :: 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)
NoExt
noExt (XHsInt (GhcPass p) -> IntegralLit -> HsLit (GhcPass p)
forall x. XHsInt x -> IntegralLit -> HsLit x
HsInt XHsInt (GhcPass p)
NoExt
noExt (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 n :: IdP (GhcPass id)
n = SrcSpanLess (LPat (GhcPass id)) -> LPat (GhcPass id)
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (XVarPat (GhcPass id)
-> Located (IdP (GhcPass id)) -> LPat (GhcPass id)
forall p. XVarPat p -> Located (IdP p) -> LPat p
VarPat XVarPat (GhcPass id)
NoExt
noExt (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 -> Pat GhcPs
nlLitPat l :: HsLit GhcPs
l = SrcSpanLess (Pat GhcPs) -> Pat GhcPs
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (XLitPat GhcPs -> HsLit GhcPs -> Pat GhcPs
forall p. XLitPat p -> HsLit p -> LPat p
LitPat XLitPat GhcPs
NoExt
noExt HsLit GhcPs
l)

nlHsApp :: LHsExpr (GhcPass id) -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
nlHsApp :: LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
nlHsApp f :: LHsExpr (GhcPass id)
f x :: 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)
NoExt
noExt 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 }) args :: [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 "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 f :: IdP (GhcPass id)
f xs :: [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 f :: IdP (GhcPass id)
f xs :: [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 ~ NoExt) => 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)
NoExt
noExt (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)
NoExt
noExt) (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 f :: HsExpr p
f a :: HsExpr p
a = XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
HsApp XApp p
NoExt
noExt (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] -> Pat GhcPs
nlConVarPat con :: RdrName
con vars :: [RdrName]
vars = RdrName -> [Pat GhcPs] -> Pat GhcPs
nlConPat RdrName
con ((RdrName -> Pat GhcPs) -> [RdrName] -> [Pat GhcPs]
forall a b. (a -> b) -> [a] -> [b]
map RdrName -> 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 con :: Name
con vars :: [Name]
vars = Name -> [LPat GhcRn] -> LPat GhcRn
nlConPatName Name
con ((Name -> LPat GhcRn) -> [Name] -> [LPat GhcRn]
forall a b. (a -> b) -> [a] -> [b]
map Name -> LPat GhcRn
forall (id :: Pass). IdP (GhcPass id) -> LPat (GhcPass id)
nlVarPat [Name]
vars)

nlInfixConPat :: RdrName -> LPat GhcPs -> LPat GhcPs -> LPat GhcPs
nlInfixConPat :: RdrName -> Pat GhcPs -> Pat GhcPs -> Pat GhcPs
nlInfixConPat con :: RdrName
con l :: Pat GhcPs
l r :: Pat GhcPs
r = SrcSpanLess (Pat GhcPs) -> Pat GhcPs
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (Located (IdP GhcPs) -> HsConPatDetails GhcPs -> Pat GhcPs
forall p. Located (IdP p) -> HsConPatDetails p -> LPat p
ConPatIn (SrcSpanLess (Located RdrName) -> Located RdrName
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc SrcSpanLess (Located RdrName)
RdrName
con)
                              (Pat GhcPs -> Pat GhcPs -> HsConPatDetails GhcPs
forall arg rec. arg -> arg -> HsConDetails arg rec
InfixCon (PprPrec -> Pat GhcPs -> Pat GhcPs
forall (p :: Pass). PprPrec -> LPat (GhcPass p) -> LPat (GhcPass p)
parenthesizePat PprPrec
opPrec Pat GhcPs
l)
                                        (PprPrec -> Pat GhcPs -> Pat GhcPs
forall (p :: Pass). PprPrec -> LPat (GhcPass p) -> LPat (GhcPass p)
parenthesizePat PprPrec
opPrec Pat GhcPs
r)))

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

nlConPatName :: Name -> [LPat GhcRn] -> LPat GhcRn
nlConPatName :: Name -> [LPat GhcRn] -> LPat GhcRn
nlConPatName con :: Name
con pats :: [LPat GhcRn]
pats =
  SrcSpanLess (LPat GhcRn) -> LPat GhcRn
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (Located (IdP GhcRn) -> HsConPatDetails GhcRn -> LPat GhcRn
forall p. Located (IdP p) -> HsConPatDetails p -> LPat p
ConPatIn (SrcSpanLess (Located Name) -> Located Name
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc Name
SrcSpanLess (Located Name)
con) ([LPat GhcRn] -> HsConPatDetails GhcRn
forall arg rec. [arg] -> HsConDetails arg rec
PrefixCon ((LPat GhcRn -> LPat GhcRn) -> [LPat GhcRn] -> [LPat 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) [LPat GhcRn]
pats)))

nlNullaryConPat :: IdP (GhcPass p) -> LPat (GhcPass p)
nlNullaryConPat :: IdP (GhcPass p) -> LPat (GhcPass p)
nlNullaryConPat con :: IdP (GhcPass p)
con = SrcSpanLess (LPat (GhcPass p)) -> LPat (GhcPass p)
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (Located (IdP (GhcPass p))
-> HsConPatDetails (GhcPass p) -> LPat (GhcPass p)
forall p. Located (IdP p) -> HsConPatDetails p -> LPat 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) ([LPat (GhcPass p)] -> HsConPatDetails (GhcPass p)
forall arg rec. [arg] -> HsConDetails arg rec
PrefixCon []))

nlWildConPat :: DataCon -> LPat GhcPs
nlWildConPat :: DataCon -> Pat GhcPs
nlWildConPat con :: DataCon
con = SrcSpanLess (Pat GhcPs) -> Pat GhcPs
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (Located (IdP GhcPs) -> HsConPatDetails GhcPs -> Pat GhcPs
forall p. Located (IdP p) -> HsConPatDetails p -> LPat 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))
                         ([Pat GhcPs] -> HsConPatDetails GhcPs
forall arg rec. [arg] -> HsConDetails arg rec
PrefixCon (Int -> Pat GhcPs -> [Pat GhcPs]
forall a. Int -> a -> [a]
nOfThem (DataCon -> Int
dataConSourceArity DataCon
con)
                                             Pat GhcPs
nlWildPat)))

nlWildPat :: LPat GhcPs
nlWildPat :: Pat GhcPs
nlWildPat  = SrcSpanLess (Pat GhcPs) -> Pat GhcPs
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (XWildPat GhcPs -> Pat GhcPs
forall p. XWildPat p -> LPat p
WildPat XWildPat GhcPs
NoExt
noExt )  -- Pre-typechecking

nlWildPatName :: LPat GhcRn
nlWildPatName :: LPat GhcRn
nlWildPatName  = SrcSpanLess (LPat GhcRn) -> LPat GhcRn
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (XWildPat GhcRn -> LPat GhcRn
forall p. XWildPat p -> LPat p
WildPat XWildPat GhcRn
NoExt
noExt )  -- Pre-typechecking

nlHsDo :: HsStmtContext Name -> [LStmt GhcPs (LHsExpr GhcPs)]
       -> LHsExpr GhcPs
nlHsDo :: HsStmtContext Name -> [ExprLStmt GhcPs] -> LHsExpr GhcPs
nlHsDo ctxt :: HsStmtContext Name
ctxt stmts :: [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 e1 :: LHsExpr GhcPs
e1 op :: IdP GhcPs
op e2 :: 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 match :: 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
NoExt
noExt (Origin
-> [LMatch GhcPs (LHsExpr GhcPs)]
-> MatchGroup GhcPs (LHsExpr GhcPs)
forall name (body :: * -> *).
(XMG name (Located (body name)) ~ NoExt) =>
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 e :: 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)
NoExt
noExt 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 cond :: LHsExpr (GhcPass id)
cond true :: LHsExpr (GhcPass id)
true false :: 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)
NoExt
noExt 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 expr :: LHsExpr GhcPs
expr matches :: [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
NoExt
noExt LHsExpr GhcPs
expr (Origin
-> [LMatch GhcPs (LHsExpr GhcPs)]
-> MatchGroup GhcPs (LHsExpr GhcPs)
forall name (body :: * -> *).
(XMG name (Located (body name)) ~ NoExt) =>
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 exprs :: [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
NoExt
noExt 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 f :: LHsType (GhcPass p)
f t :: 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)
NoExt
noExt 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 x :: 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)
NoExt
noExt 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 a :: LHsType (GhcPass p)
a b :: 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)
NoExt
noExt (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 t :: 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)
NoExt
noExt 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 tycon :: IdP (GhcPass p)
tycon tys :: [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 f :: LHsType (GhcPass p)
f k :: 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 [e :: LHsExpr (GhcPass a)
e] = LHsExpr (GhcPass a)
e
mkLHsTupleExpr es :: [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)
NoExt
noExt ((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)
NoExt
noExt)) [LHsExpr (GhcPass a)]
es) Boxity
Boxed

mkLHsVarTuple :: [IdP (GhcPass a)] -> LHsExpr (GhcPass a)
mkLHsVarTuple :: [IdP (GhcPass a)] -> LHsExpr (GhcPass a)
mkLHsVarTuple ids :: [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 :: [Pat GhcPs] -> Boxity -> Pat GhcPs
nlTuplePat pats :: [Pat GhcPs]
pats box :: Boxity
box = SrcSpanLess (Pat GhcPs) -> Pat GhcPs
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (XTuplePat GhcPs -> [Pat GhcPs] -> Boxity -> Pat GhcPs
forall p. XTuplePat p -> [LPat p] -> Boxity -> LPat p
TuplePat XTuplePat GhcPs
NoExt
noExt [Pat GhcPs]
pats Boxity
box)

missingTupArg :: HsTupArg GhcPs
missingTupArg :: HsTupArg GhcPs
missingTupArg = XMissing GhcPs -> HsTupArg GhcPs
forall id. XMissing id -> HsTupArg id
Missing XMissing GhcPs
NoExt
noExt

mkLHsPatTup :: [LPat GhcRn] -> LPat GhcRn
mkLHsPatTup :: [LPat GhcRn] -> LPat GhcRn
mkLHsPatTup []     = SrcSpanLess (LPat GhcRn) -> LPat GhcRn
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (SrcSpanLess (LPat GhcRn) -> LPat GhcRn)
-> SrcSpanLess (LPat GhcRn) -> LPat GhcRn
forall a b. (a -> b) -> a -> b
$ XTuplePat GhcRn -> [LPat GhcRn] -> Boxity -> LPat GhcRn
forall p. XTuplePat p -> [LPat p] -> Boxity -> LPat p
TuplePat XTuplePat GhcRn
NoExt
noExt [] Boxity
Boxed
mkLHsPatTup [lpat :: LPat GhcRn
lpat] = LPat GhcRn
lpat
mkLHsPatTup lpats :: [LPat GhcRn]
lpats  = SrcSpan -> SrcSpanLess (LPat GhcRn) -> LPat GhcRn
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL (LPat GhcRn -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc ([LPat GhcRn] -> LPat GhcRn
forall a. [a] -> a
head [LPat GhcRn]
lpats)) (SrcSpanLess (LPat GhcRn) -> LPat GhcRn)
-> SrcSpanLess (LPat GhcRn) -> LPat GhcRn
forall a b. (a -> b) -> a -> b
$ XTuplePat GhcRn -> [LPat GhcRn] -> Boxity -> LPat GhcRn
forall p. XTuplePat p -> [LPat p] -> Boxity -> LPat p
TuplePat XTuplePat GhcRn
NoExt
noExt [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 ids :: [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 bs :: [IdP GhcRn]
bs = [LPat GhcRn] -> LPat GhcRn
mkBigLHsPatTup ((Name -> LPat GhcRn) -> [Name] -> [LPat GhcRn]
forall a b. (a -> b) -> [a] -> [b]
map Name -> LPat 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 = ([LPat GhcRn] -> LPat GhcRn) -> [LPat GhcRn] -> LPat GhcRn
forall a. ([a] -> a) -> [a] -> a
mkChunkified [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 small_tuple :: [a] -> a
small_tuple as :: [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 [as :: [a]
as] = [a] -> a
small_tuple [a]
as
    mk_big_tuple as_s :: [[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 xs :: [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 xs :: [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 ty :: 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 ty :: 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 get_info :: LSig GhcRn -> Maybe ([Located Name], a)
get_info sigs :: [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 (Trac #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
    (gen_dm_sigs :: [LSig GhcRn]
gen_dm_sigs, ordinary_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 _ (ClassOpSig _ True _ _)) = Bool
True
    is_gen_dm_sig _                                 = Bool
False

    mk_pairs :: [LSig GhcRn] -> [(Name, a)]
    mk_pairs :: [LSig GhcRn] -> [(Name, a)]
mk_pairs sigs :: [LSig GhcRn]
sigs = [ (Name
SrcSpanLess (Located Name)
n,a
a) | Just (ns :: [Located Name]
ns,a :: 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 _ n :: 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 sigs :: [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 ~ NoExt) =>
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 loc :: 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
NoExt
noExt Bool
False [Located (IdP pass)]
nms (LHsSigWcType pass -> LHsSigType pass
forall pass. LHsSigWcType pass -> LHsSigType pass
dropWildCards LHsSigWcType pass
ty))
    fiddle sig :: 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 ty :: Type
ty
  = Type -> LHsType GhcPs
go Type
ty
  where
    go :: Type -> LHsType GhcPs
    go :: Type -> LHsType GhcPs
go ty :: Type
ty@(FunTy arg :: Type
arg _)
      | Type -> Bool
isPredTy Type
arg
      , (theta :: [Type]
theta, tau :: 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
NoExt
noExt
                        , hst_body :: LHsType GhcPs
hst_body = Type -> LHsType GhcPs
go Type
tau })
    go (FunTy arg :: Type
arg res :: Type
res) = 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)
    go ty :: Type
ty@(ForAllTy {})
      | (tvs :: [TyVar]
tvs, tau :: Type
tau) <- Type -> ([TyVar], Type)
tcSplitForAllTys Type
ty
      = SrcSpanLess (LHsType GhcPs) -> LHsType GhcPs
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (HsForAllTy :: forall pass.
XForAllTy pass
-> [LHsTyVarBndr pass] -> LHsType pass -> HsType pass
HsForAllTy { 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
NoExt
noExt
                          , hst_body :: LHsType GhcPs
hst_body = Type -> LHsType GhcPs
go Type
tau })
    go (TyVarTy tv :: 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 (AppTy t1 :: Type
t1 t2 :: Type
t2)        = LHsType GhcPs -> LHsType GhcPs -> LHsType GhcPs
forall (p :: Pass).
LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)
nlHsAppTy (Type -> LHsType GhcPs
go Type
t1) (Type -> LHsType GhcPs
go Type
t2)
    go (LitTy (NumTyLit n :: 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
NoExt
NoExt (SourceText -> Integer -> HsTyLit
HsNumTy SourceText
NoSourceText Integer
n)
    go (LitTy (StrTyLit s :: 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
NoExt
NoExt (SourceText -> FastString -> HsTyLit
HsStrTy SourceText
NoSourceText FastString
s)
    go ty :: Type
ty@(TyConApp tc :: TyCon
tc args :: [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
NoExt
NoExt LHsType GhcPs
lhs_ty (Type -> LHsType GhcPs
go (HasDebugCallStack => Type -> Type
Type -> Type
typeKind Type
ty))
      | Bool
otherwise = LHsType GhcPs
lhs_ty
       where
        arg_flags :: [ArgFlag]
        arg_flags :: [ArgFlag]
arg_flags = TyCon -> [Type] -> [ArgFlag]
tyConArgFlags TyCon
tc [Type]
args

        lhs_ty :: LHsType GhcPs
        lhs_ty :: LHsType GhcPs
lhs_ty = (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' (\f :: LHsType GhcPs
f (arg :: Type
arg, flag :: ArgFlag
flag) ->
                          let arg' :: LHsType GhcPs
arg' = Type -> LHsType GhcPs
go Type
arg in
                          case ArgFlag
flag of
                            Inferred  -> LHsType GhcPs
f
                            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'
                            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')
                        (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] -> [ArgFlag] -> [(Type, ArgFlag)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Type]
args [ArgFlag]
arg_flags)
    go (CastTy ty :: Type
ty _)        = Type -> LHsType GhcPs
go Type
ty
    go (CoercionTy co :: Coercion
co)      = String -> SDoc -> LHsType GhcPs
forall a. HasCallStack => String -> SDoc -> a
pprPanic "toLHsSigWcType" (Coercion -> SDoc
forall a. Outputable a => a -> SDoc
ppr Coercion
co)

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

    go_tv :: TyVar -> LHsTyVarBndr GhcPs
    go_tv :: TyVar -> LHsTyVarBndr GhcPs
go_tv 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
NoExt
noExt (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 Trac #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 co_fn :: HsWrapper
co_fn (LHsExpr (GhcPass id)
-> Located (SrcSpanLess (LHsExpr (GhcPass id)))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L loc :: SrcSpan
loc e :: 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 co_fn :: HsWrapper
co_fn e :: HsExpr (GhcPass id)
e | HsWrapper -> Bool
isIdHsWrapper HsWrapper
co_fn = HsExpr (GhcPass id)
e
mkHsWrap co_fn :: HsWrapper
co_fn (HsWrap _ co_fn' :: HsWrapper
co_fn' e :: 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 co_fn :: HsWrapper
co_fn e :: 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)
NoExt
noExt HsWrapper
co_fn HsExpr (GhcPass id)
e

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

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

mkLHsWrapCo :: TcCoercionN -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
mkLHsWrapCo :: Coercion -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
mkLHsWrapCo co :: Coercion
co (LHsExpr (GhcPass id)
-> Located (SrcSpanLess (LHsExpr (GhcPass id)))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L loc :: SrcSpan
loc e :: SrcSpanLess (LHsExpr (GhcPass id))
e) = SrcSpan
-> SrcSpanLess (LHsExpr (GhcPass id)) -> LHsExpr (GhcPass id)
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
loc (Coercion -> HsExpr (GhcPass id) -> HsExpr (GhcPass id)
forall (id :: Pass).
Coercion -> HsExpr (GhcPass id) -> HsExpr (GhcPass id)
mkHsWrapCo Coercion
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 w :: HsWrapper
w cmd :: 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)
NoExt
noExt HsWrapper
w HsCmd (GhcPass p)
cmd

mkLHsCmdWrap :: HsWrapper -> LHsCmd (GhcPass p) -> LHsCmd (GhcPass p)
mkLHsCmdWrap :: HsWrapper -> LHsCmd (GhcPass p) -> LHsCmd (GhcPass p)
mkLHsCmdWrap w :: HsWrapper
w (LHsCmd (GhcPass p) -> Located (SrcSpanLess (LHsCmd (GhcPass p)))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L loc :: SrcSpan
loc c :: 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 co_fn :: HsWrapper
co_fn p :: Pat (GhcPass id)
p ty :: 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 -> LPat p -> Type -> LPat p
CoPat XCoPat (GhcPass id)
NoExt
noExt HsWrapper
co_fn Pat (GhcPass id)
p Type
ty

mkHsWrapPatCo :: TcCoercionN -> Pat (GhcPass id) -> Type -> Pat (GhcPass id)
mkHsWrapPatCo :: Coercion -> Pat (GhcPass id) -> Type -> Pat (GhcPass id)
mkHsWrapPatCo co :: Coercion
co pat :: Pat (GhcPass id)
pat ty :: Type
ty | Coercion -> Bool
isTcReflCo Coercion
co = Pat (GhcPass id)
pat
                        | Bool
otherwise    = XCoPat (GhcPass id)
-> HsWrapper -> Pat (GhcPass id) -> Type -> Pat (GhcPass id)
forall p. XCoPat p -> HsWrapper -> LPat p -> Type -> LPat p
CoPat XCoPat (GhcPass id)
NoExt
noExt (Coercion -> HsWrapper
mkWpCastN Coercion
co) Pat (GhcPass id)
pat Type
ty

mkHsDictLet :: TcEvBinds -> LHsExpr GhcTc -> LHsExpr GhcTc
mkHsDictLet :: TcEvBinds -> LHsExpr GhcTc -> LHsExpr GhcTc
mkHsDictLet ev_binds :: TcEvBinds
ev_binds expr :: 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 :: Located RdrName -> [LMatch GhcPs (LHsExpr GhcPs)]
          -> HsBind GhcPs
-- Not infix, with place holders for coercion and free vars
mkFunBind :: Located RdrName -> [LMatch GhcPs (LHsExpr GhcPs)] -> HsBind GhcPs
mkFunBind fn :: Located RdrName
fn ms :: [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)) ~ NoExt) =>
Origin
-> [LMatch name (Located (body name))]
-> MatchGroup name (Located (body name))
mkMatchGroup Origin
Generated [LMatch GhcPs (LHsExpr GhcPs)]
ms
                          , fun_co_fn :: HsWrapper
fun_co_fn = HsWrapper
idHsWrapper
                          , fun_ext :: XFunBind GhcPs GhcPs
fun_ext = XFunBind GhcPs GhcPs
NoExt
noExt
                          , 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
origin fn :: Located Name
fn ms :: [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)) ~ NoExt) =>
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 loc :: SrcSpan
loc var :: RdrName
var rhs :: LHsExpr GhcPs
rhs = SrcSpan -> RdrName -> [Pat GhcPs] -> LHsExpr GhcPs -> LHsBind GhcPs
mk_easy_FunBind 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 var :: IdP (GhcPass p)
var rhs :: 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)
NoExt
noExt,
                              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)
-> Pat GhcPs
-> HsPatSynDir GhcPs
-> HsBind GhcPs
mkPatSynBind name :: Located RdrName
name details :: HsPatSynDetails (Located RdrName)
details lpat :: Pat GhcPs
lpat dir :: 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
NoExt
noExt 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
NoExt
noExt
             , 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 :: Pat GhcPs
psb_def = Pat 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 _ _ (MG _ matches :: Located [LMatch id2 (LHsExpr id2)]
matches _) _ _)
  = (LMatch id2 (LHsExpr id2) -> Bool)
-> [LMatch id2 (LHsExpr id2)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Match id2 (LHsExpr id2) -> Bool
forall id body. Match id body -> Bool
isInfixMatch (Match id2 (LHsExpr id2) -> Bool)
-> (LMatch id2 (LHsExpr id2) -> Match id2 (LHsExpr id2))
-> LMatch id2 (LHsExpr id2)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 _ = Bool
False


------------
mk_easy_FunBind :: SrcSpan -> RdrName -> [LPat GhcPs]
                -> LHsExpr GhcPs -> LHsBind GhcPs
mk_easy_FunBind :: SrcSpan -> RdrName -> [Pat GhcPs] -> LHsExpr GhcPs -> LHsBind GhcPs
mk_easy_FunBind loc :: SrcSpan
loc fun :: RdrName
fun pats :: [Pat GhcPs]
pats expr :: 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
$ Located RdrName -> [LMatch GhcPs (LHsExpr GhcPs)] -> HsBind GhcPs
mkFunBind (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))
-> [Pat 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)) [Pat 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 n :: 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 ctxt :: HsMatchContext (NameOrRdrName (IdP (GhcPass p)))
ctxt pats :: [LPat (GhcPass p)]
pats expr :: LHsExpr (GhcPass p)
expr lbinds :: 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))
NoExt
noExt
                 , 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) -> LPat (GhcPass p))
-> [LPat (GhcPass p)] -> [LPat (GhcPass p)]
forall a b. (a -> b) -> [a] -> [b]
map LPat (GhcPass p) -> LPat (GhcPass p)
forall p.
(HasSrcSpan (Pat p), XParPat p ~ NoExt,
 SrcSpanLess (Pat p) ~ Pat p) =>
Pat p -> Pat p
paren [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))
NoExt
noExt (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 :: Pat p -> Pat p
paren lp :: Pat p
lp@(Pat p -> Located (SrcSpanLess (Pat p))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L l :: SrcSpan
l p :: SrcSpanLess (Pat p)
p)
      | PprPrec -> Pat p -> Bool
forall p. PprPrec -> Pat p -> Bool
patNeedsParens PprPrec
appPrec SrcSpanLess (Pat p)
Pat p
p = SrcSpan -> SrcSpanLess (Pat p) -> Pat p
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
l (XParPat p -> Pat p -> Pat p
forall p. XParPat p -> LPat p -> LPat p
ParPat XParPat p
NoExt
noExt Pat p
lp)
      | Bool
otherwise                = Pat p
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 HsBinds Note [The abs_sig field of AbsBinds]
-}

----------------- 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 bind :: 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) ~ LPat p, HasSrcSpan (LPat p)) =>
HsBindLR p idR -> [IdP p]
collectHsBindBinders HsBind GhcTc
bind)
  where
    is_unlifted_id :: TyVar -> Bool
is_unlifted_id 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 _
  = Bool
False

collectLocalBinders :: HsLocalBindsLR (GhcPass idL) (GhcPass idR)
                    -> [IdP (GhcPass idL)]
collectLocalBinders :: HsLocalBindsLR (GhcPass idL) (GhcPass idR) -> [IdP (GhcPass idL)]
collectLocalBinders (HsValBinds _ binds :: 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 _) = []
collectLocalBinders (XHsLocalBindsLR _) = []

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 b :: HsBindLR p idR
b = Bool -> HsBindLR p idR -> [IdP p] -> [IdP p]
forall p idR.
(SrcSpanLess (LPat p) ~ LPat 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 binds :: 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) ~ LPat 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 ps :: Bool
ps (ValBinds _ binds :: LHsBindsLR (GhcPass idL) (GhcPass idR)
binds _) = 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 ps :: 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 ps :: 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 ps :: Bool
ps binds :: LHsBindsLR (GhcPass p) idR
binds acc :: [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 a r. (a -> r -> r) -> r -> Bag a -> r
foldrBag (Bool
-> HsBindLR (GhcPass p) idR
-> [IdP (GhcPass p)]
-> [IdP (GhcPass p)]
forall p idR.
(SrcSpanLess (LPat p) ~ LPat 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 _ (PatBind { pat_lhs :: forall idL idR. HsBindLR idL idR -> LPat idL
pat_lhs = LPat p
p })           acc :: [IdP p]
acc = LPat p -> [IdP p] -> [IdP p]
forall p.
(SrcSpanLess (LPat p) ~ LPat p, HasSrcSpan (LPat p)) =>
LPat p -> [IdP p] -> [IdP p]
collect_lpat LPat p
p [IdP p]
acc
collect_bind _ (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 _ f :: SrcSpanLess (Located (IdP p))
f) })  acc :: [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 _ (VarBind { var_id :: forall idL idR. HsBindLR idL idR -> IdP idL
var_id = IdP p
f })            acc :: [IdP p]
acc = IdP p
f IdP p -> [IdP p] -> [IdP p]
forall a. a -> [a] -> [a]
: [IdP p]
acc
collect_bind _ (AbsBinds { abs_exports :: forall idL idR. HsBindLR idL idR -> [ABExport idL]
abs_exports = [ABExport p]
dbinds }) acc :: [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 omitPatSyn :: Bool
omitPatSyn (PatSynBind _ (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 _ ps :: SrcSpanLess (Located (IdP p))
ps) })) acc :: [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 _ (PatSynBind _ (XPatSynBind _)) acc :: [IdP p]
acc = [IdP p]
acc
collect_bind _ (XHsBindsLR _) acc :: [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 binds :: LHsBindsLR idL idR
binds = (LHsBindLR idL idR -> [Located (IdP idL)] -> [Located (IdP idL)])
-> [Located (IdP idL)] -> LHsBindsLR idL idR -> [Located (IdP idL)]
forall a r. (a -> r -> r) -> r -> Bag a -> r
foldrBag (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 }) fs :: [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 _                        fs :: [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 _ pat :: LPat (GhcPass idL)
pat _ _ _)  = LPat (GhcPass idL) -> [IdP (GhcPass idL)]
forall (p :: Pass). LPat (GhcPass p) -> [IdP (GhcPass p)]
collectPatBinders LPat (GhcPass idL)
pat
collectStmtBinders (LetStmt _  binds :: 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 _ xs :: [ParStmtBlock (GhcPass idL) (GhcPass idR)]
xs _ _)      = [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 _ ss :: [LStmtLR (GhcPass idL) (GhcPass idL) (LHsExpr (GhcPass idL))]
ss _ _ <- [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 _ args :: [(SyntaxExpr (GhcPass idR), ApplicativeArg (GhcPass idL))]
args _) = ((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 (_, ApplicativeArgOne _ pat :: 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 (_, ApplicativeArgMany _ _ _ pat :: 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 _ = []
collectStmtBinders XStmtLR{} = String -> [IdP (GhcPass idL)]
forall a. String -> a
panic "collectStmtBinders"


----------------- Patterns --------------------------
collectPatBinders :: LPat (GhcPass p) -> [IdP (GhcPass p)]
collectPatBinders :: LPat (GhcPass p) -> [IdP (GhcPass p)]
collectPatBinders pat :: LPat (GhcPass p)
pat = LPat (GhcPass p) -> [IdP (GhcPass p)] -> [IdP (GhcPass p)]
forall p.
(SrcSpanLess (LPat p) ~ LPat 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 pats :: [LPat (GhcPass p)]
pats = (LPat (GhcPass p) -> [IdP (GhcPass p)] -> [IdP (GhcPass p)])
-> [IdP (GhcPass p)] -> [LPat (GhcPass p)] -> [IdP (GhcPass p)]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr LPat (GhcPass p) -> [IdP (GhcPass p)] -> [IdP (GhcPass p)]
forall p.
(SrcSpanLess (LPat p) ~ LPat p, HasSrcSpan (LPat p)) =>
LPat p -> [IdP p] -> [IdP p]
collect_lpat [] [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 p :: LPat p
p bndrs :: [IdP p]
bndrs
  = LPat p -> [IdP p]
go (LPat p -> SrcSpanLess (LPat p)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LPat p
p)
  where
    go :: LPat p -> [IdP p]
go (VarPat _ var :: 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 _)                = [IdP p]
bndrs
    go (LazyPat _ pat :: LPat p
pat)            = LPat p -> [IdP p] -> [IdP p]
forall p.
(SrcSpanLess (LPat p) ~ LPat p, HasSrcSpan (LPat p)) =>
LPat p -> [IdP p] -> [IdP p]
collect_lpat LPat p
pat [IdP p]
bndrs
    go (BangPat _ pat :: LPat p
pat)            = LPat p -> [IdP p] -> [IdP p]
forall p.
(SrcSpanLess (LPat p) ~ LPat p, HasSrcSpan (LPat p)) =>
LPat p -> [IdP p] -> [IdP p]
collect_lpat LPat p
pat [IdP p]
bndrs
    go (AsPat _ a :: Located (IdP p)
a pat :: 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) ~ LPat p, HasSrcSpan (LPat p)) =>
LPat p -> [IdP p] -> [IdP p]
collect_lpat LPat p
pat [IdP p]
bndrs
    go (ViewPat _ _ pat :: LPat p
pat)          = LPat p -> [IdP p] -> [IdP p]
forall p.
(SrcSpanLess (LPat p) ~ LPat p, HasSrcSpan (LPat p)) =>
LPat p -> [IdP p] -> [IdP p]
collect_lpat LPat p
pat [IdP p]
bndrs
    go (ParPat _ pat :: LPat p
pat)             = LPat p -> [IdP p] -> [IdP p]
forall p.
(SrcSpanLess (LPat p) ~ LPat p, HasSrcSpan (LPat p)) =>
LPat p -> [IdP p] -> [IdP p]
collect_lpat LPat p
pat [IdP p]
bndrs

    go (ListPat _ pats :: [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) ~ LPat p, HasSrcSpan (LPat p)) =>
LPat p -> [IdP p] -> [IdP p]
collect_lpat [IdP p]
bndrs [LPat p]
pats
    go (TuplePat _ pats :: [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) ~ LPat p, HasSrcSpan (LPat p)) =>
LPat p -> [IdP p] -> [IdP p]
collect_lpat [IdP p]
bndrs [LPat p]
pats
    go (SumPat _ pat :: LPat p
pat _ _)         = LPat p -> [IdP p] -> [IdP p]
forall p.
(SrcSpanLess (LPat p) ~ LPat p, HasSrcSpan (LPat p)) =>
LPat p -> [IdP p] -> [IdP p]
collect_lpat LPat p
pat [IdP p]
bndrs

    go (ConPatIn _ ps :: 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) ~ LPat 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. LPat 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) ~ LPat 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 _ _)               = [IdP p]
bndrs
    go (NPat {})                  = [IdP p]
bndrs
    go (NPlusKPat _ n :: Located (IdP p)
n _ _ _ _)    = 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 _ pat :: LPat p
pat _)           = LPat p -> [IdP p] -> [IdP p]
forall p.
(SrcSpanLess (LPat p) ~ LPat p, HasSrcSpan (LPat p)) =>
LPat p -> [IdP p] -> [IdP p]
collect_lpat LPat p
pat [IdP p]
bndrs

    go (SplicePat _ (HsSpliced _ _ (HsSplicedPat pat :: LPat p
pat)))
                                  = LPat p -> [IdP p]
go LPat p
pat
    go (SplicePat _ _)            = [IdP p]
bndrs
    go (CoPat _ _ pat :: LPat p
pat _)          = LPat p -> [IdP p]
go LPat 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 {}) = String -> [Name]
forall a. String -> a
panic "hsGroupBinders"

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


-------------------
hsForeignDeclsBinders :: [LForeignDecl pass] -> [Located (IdP pass)]
-- See Note [SrcSpan for binders]
hsForeignDeclsBinders :: [LForeignDecl pass] -> [Located (IdP pass)]
hsForeignDeclsBinders foreign_decls :: [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 decl_loc :: 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 _ _ _) = String -> [IdP (GhcPass p)]
forall a. String -> a
panic "hsPatSynSelectors"
hsPatSynSelectors (XValBindsLR (NValBinds binds _))
  = (LHsBind (GhcPass p) -> [IdP (GhcPass p)] -> [IdP (GhcPass p)])
-> [IdP (GhcPass p)]
-> Bag (LHsBind (GhcPass p))
-> [IdP (GhcPass p)]
forall a r. (a -> r -> r) -> r -> Bag a -> r
foldrBag LHsBind (GhcPass p) -> [IdP (GhcPass p)] -> [IdP (GhcPass p)]
forall p. LHsBind p -> [IdP p] -> [IdP p]
addPatSynSelector [] (Bag (LHsBind (GhcPass p)) -> [IdP (GhcPass p)])
-> ([Bag (LHsBind (GhcPass p))] -> Bag (LHsBind (GhcPass p)))
-> [Bag (LHsBind (GhcPass p))]
-> [IdP (GhcPass p)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Bag (LHsBind (GhcPass p))] -> Bag (LHsBind (GhcPass p))
forall a. [Bag a] -> Bag a
unionManyBags ([Bag (LHsBind (GhcPass p))] -> [IdP (GhcPass p)])
-> [Bag (LHsBind (GhcPass p))] -> [IdP (GhcPass p)]
forall a b. (a -> b) -> a -> b
$ ((RecFlag, Bag (LHsBind (GhcPass p))) -> Bag (LHsBind (GhcPass p)))
-> [(RecFlag, Bag (LHsBind (GhcPass p)))]
-> [Bag (LHsBind (GhcPass p))]
forall a b. (a -> b) -> [a] -> [b]
map (RecFlag, Bag (LHsBind (GhcPass p))) -> Bag (LHsBind (GhcPass p))
forall a b. (a, b) -> b
snd [(RecFlag, Bag (LHsBind (GhcPass p)))]
binds

addPatSynSelector:: LHsBind p -> [IdP p] -> [IdP p]
addPatSynSelector :: LHsBind p -> [IdP p] -> [IdP p]
addPatSynSelector bind :: LHsBind p
bind sels :: [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 binds :: [(RecFlag, LHsBinds id)]
binds
  = [ PatSynBind id id
psb | (_, lbinds :: 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 _ (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 _ (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 pass.
DataFamInstDecl pass -> ([Located (IdP pass)], [LFieldOcc pass])
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 _ (DataFamInstD { dfid_inst = fi }))
  = DataFamInstDecl (GhcPass p)
-> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
forall pass.
DataFamInstDecl pass -> ([Located (IdP pass)], [LFieldOcc pass])
hsDataFamInstBinders DataFamInstDecl (GhcPass p)
fi
hsLInstDeclBinders (LInstDecl (GhcPass p)
-> Located (SrcSpanLess (LInstDecl (GhcPass p)))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L _ (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 _ (ClsInstD _ (XClsInstDecl {})))
  = String -> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
forall a. String -> a
panic "hsLInstDeclBinders"
hsLInstDeclBinders (LInstDecl (GhcPass p)
-> Located (SrcSpanLess (LInstDecl (GhcPass p)))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L _ (XInstDecl _))
  = String -> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
forall a. String -> a
panic "hsLInstDeclBinders"
hsLInstDeclBinders _ = String -> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
forall a. String -> a
panic "hsLInstDeclBinders: Impossible Match"
                             -- due to #15884

-------------------
-- the SrcLoc returned are for the whole declarations, not just the names
hsDataFamInstBinders :: DataFamInstDecl pass
                     -> ([Located (IdP pass)], [LFieldOcc pass])
hsDataFamInstBinders :: DataFamInstDecl pass -> ([Located (IdP pass)], [LFieldOcc pass])
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 pats rhs. FamEqn pass pats rhs -> rhs
feqn_rhs = HsDataDefn pass
defn }}})
  = HsDataDefn pass -> ([Located (IdP pass)], [LFieldOcc pass])
forall pass.
HsDataDefn pass -> ([Located (IdP pass)], [LFieldOcc pass])
hsDataDefnBinders HsDataDefn pass
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 _}})
  = String -> ([Located (IdP pass)], [LFieldOcc pass])
forall a. String -> a
panic "hsDataFamInstBinders"
hsDataFamInstBinders (DataFamInstDecl (XHsImplicitBndrs _))
  = String -> ([Located (IdP pass)], [LFieldOcc pass])
forall a. String -> a
panic "hsDataFamInstBinders"

-------------------
-- the SrcLoc returned are for the whole declarations, not just the names
hsDataDefnBinders :: HsDataDefn pass -> ([Located (IdP pass)], [LFieldOcc pass])
hsDataDefnBinders :: HsDataDefn pass -> ([Located (IdP pass)], [LFieldOcc pass])
hsDataDefnBinders (HsDataDefn { dd_cons :: forall pass. HsDataDefn pass -> [LConDecl pass]
dd_cons = [LConDecl pass]
cons })
  = [LConDecl pass] -> ([Located (IdP pass)], [LFieldOcc pass])
forall pass.
[LConDecl pass] -> ([Located (IdP pass)], [LFieldOcc pass])
hsConDeclsBinders [LConDecl pass]
cons
  -- See Note [Binders in family instances]
hsDataDefnBinders (XHsDataDefn _) = String -> ([Located (IdP pass)], [LFieldOcc pass])
forall a. String -> a
panic "hsDataDefnBinders"

-------------------
type Seen pass = [LFieldOcc pass] -> [LFieldOcc pass]
                 -- Filters out ones that have already been seen

hsConDeclsBinders :: [LConDecl pass] -> ([Located (IdP pass)], [LFieldOcc pass])
   -- 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 pass] -> ([Located (IdP pass)], [LFieldOcc pass])
hsConDeclsBinders cons :: [LConDecl pass]
cons
  = Seen pass
-> [LConDecl pass] -> ([Located (IdP pass)], [LFieldOcc pass])
forall pass.
Seen pass
-> [LConDecl pass] -> ([Located (IdP pass)], [LFieldOcc pass])
go Seen pass
forall a. a -> a
id [LConDecl pass]
cons
  where
    go :: Seen pass -> [LConDecl pass]
       -> ([Located (IdP pass)], [LFieldOcc pass])
    go :: Seen pass
-> [LConDecl pass] -> ([Located (IdP pass)], [LFieldOcc pass])
go _ [] = ([], [])
    go remSeen :: Seen pass
remSeen (r :: LConDecl pass
r:rs :: [LConDecl pass]
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 pass -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc LConDecl pass
r
        in case LConDecl pass -> SrcSpanLess (LConDecl pass)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LConDecl pass
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 pass) -> Located (IdP pass))
-> [Located (IdP pass)] -> [Located (IdP pass)]
forall a b. (a -> b) -> [a] -> [b]
map (SrcSpan -> SrcSpanLess (Located (IdP pass)) -> Located (IdP pass)
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
loc (IdP pass -> Located (IdP pass))
-> (Located (IdP pass) -> IdP pass)
-> Located (IdP pass)
-> Located (IdP pass)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located (IdP pass) -> IdP pass
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) [Located (IdP pass)]
names [Located (IdP pass)]
-> [Located (IdP pass)] -> [Located (IdP pass)]
forall a. [a] -> [a] -> [a]
++ [Located (IdP pass)]
ns, [LFieldOcc pass]
flds [LFieldOcc pass] -> Seen pass
forall a. [a] -> [a] -> [a]
++ [LFieldOcc pass]
fs)
             where
                (remSeen' :: Seen pass
remSeen', flds :: [LFieldOcc pass]
flds) = Seen pass -> HsConDeclDetails pass -> (Seen pass, [LFieldOcc pass])
forall pass.
Seen pass -> HsConDeclDetails pass -> (Seen pass, [LFieldOcc pass])
get_flds Seen pass
remSeen HsConDeclDetails pass
args
                (ns :: [Located (IdP pass)]
ns, fs :: [LFieldOcc pass]
fs) = Seen pass
-> [LConDecl pass] -> ([Located (IdP pass)], [LFieldOcc pass])
forall pass.
Seen pass
-> [LConDecl pass] -> ([Located (IdP pass)], [LFieldOcc pass])
go Seen pass
remSeen' [LConDecl pass]
rs

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

           XConDecl _ -> String -> ([Located (IdP pass)], [LFieldOcc pass])
forall a. String -> a
panic "hsConDeclsBinders"

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

lStmtsImplicits :: [LStmtLR GhcRn (GhcPass idR) (Located (body (GhcPass idR)))]
                -> NameSet
lStmtsImplicits :: [LStmtLR GhcRn (GhcPass idR) (Located (body (GhcPass idR)))]
-> NameSet
lStmtsImplicits = [LStmtLR GhcRn (GhcPass idR) (Located (body (GhcPass idR)))]
-> NameSet
forall (idR :: Pass) (body :: * -> *).
[LStmtLR GhcRn (GhcPass idR) (Located (body (GhcPass idR)))]
-> NameSet
hs_lstmts
  where
    hs_lstmts :: [LStmtLR GhcRn (GhcPass idR) (Located (body (GhcPass idR)))]
              -> NameSet
    hs_lstmts :: [LStmtLR GhcRn (GhcPass idR) (Located (body (GhcPass idR)))]
-> NameSet
hs_lstmts = (LStmtLR GhcRn (GhcPass idR) (Located (body (GhcPass idR)))
 -> NameSet -> NameSet)
-> NameSet
-> [LStmtLR GhcRn (GhcPass idR) (Located (body (GhcPass idR)))]
-> NameSet
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\stmt :: LStmtLR GhcRn (GhcPass idR) (Located (body (GhcPass idR)))
stmt rest :: NameSet
rest -> NameSet -> NameSet -> NameSet
unionNameSet (StmtLR GhcRn (GhcPass idR) (Located (body (GhcPass idR)))
-> NameSet
forall (idR :: Pass) (body :: * -> *).
StmtLR GhcRn (GhcPass idR) (Located (body (GhcPass idR)))
-> NameSet
hs_stmt (LStmtLR GhcRn (GhcPass idR) (Located (body (GhcPass idR)))
-> SrcSpanLess
     (LStmtLR GhcRn (GhcPass idR) (Located (body (GhcPass idR))))
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LStmtLR GhcRn (GhcPass idR) (Located (body (GhcPass idR)))
stmt)) NameSet
rest) NameSet
emptyNameSet

    hs_stmt :: StmtLR GhcRn (GhcPass idR) (Located (body (GhcPass idR)))
            -> NameSet
    hs_stmt :: StmtLR GhcRn (GhcPass idR) (Located (body (GhcPass idR)))
-> NameSet
hs_stmt (BindStmt _ pat :: LPat GhcRn
pat _ _ _) = LPat GhcRn -> NameSet
lPatImplicits LPat GhcRn
pat
    hs_stmt (ApplicativeStmt _ args :: [(SyntaxExpr (GhcPass idR), ApplicativeArg GhcRn)]
args _) = [NameSet] -> NameSet
unionNameSets (((SyntaxExpr (GhcPass idR), ApplicativeArg GhcRn) -> NameSet)
-> [(SyntaxExpr (GhcPass idR), ApplicativeArg GhcRn)] -> [NameSet]
forall a b. (a -> b) -> [a] -> [b]
map (SyntaxExpr (GhcPass idR), ApplicativeArg GhcRn) -> NameSet
forall a. (a, ApplicativeArg GhcRn) -> NameSet
do_arg [(SyntaxExpr (GhcPass idR), ApplicativeArg GhcRn)]
args)
      where do_arg :: (a, ApplicativeArg GhcRn) -> NameSet
do_arg (_, ApplicativeArgOne _ pat :: LPat GhcRn
pat _ _) = LPat GhcRn -> NameSet
lPatImplicits LPat GhcRn
pat
            do_arg (_, ApplicativeArgMany _ stmts :: [ExprLStmt GhcRn]
stmts _ _) = [ExprLStmt GhcRn] -> NameSet
forall (idR :: Pass) (body :: * -> *).
[LStmtLR GhcRn (GhcPass idR) (Located (body (GhcPass idR)))]
-> NameSet
hs_lstmts [ExprLStmt GhcRn]
stmts
            do_arg (_, XApplicativeArg _) = String -> NameSet
forall a. String -> a
panic "lStmtsImplicits"
    hs_stmt (LetStmt _ binds :: LHsLocalBindsLR GhcRn (GhcPass idR)
binds)     = HsLocalBindsLR GhcRn (GhcPass idR) -> NameSet
forall (idR :: Pass). HsLocalBindsLR GhcRn (GhcPass idR) -> NameSet
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 {})         = NameSet
emptyNameSet
    hs_stmt (LastStmt {})         = NameSet
emptyNameSet
    hs_stmt (ParStmt _ xs :: [ParStmtBlock GhcRn (GhcPass idR)]
xs _ _)    = [ExprLStmt GhcRn] -> NameSet
forall (idR :: Pass) (body :: * -> *).
[LStmtLR GhcRn (GhcPass idR) (Located (body (GhcPass idR)))]
-> NameSet
hs_lstmts [ExprLStmt GhcRn
s | ParStmtBlock _ ss :: [ExprLStmt GhcRn]
ss _ _ <- [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] -> NameSet
forall (idR :: Pass) (body :: * -> *).
[LStmtLR GhcRn (GhcPass idR) (Located (body (GhcPass idR)))]
-> NameSet
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)))]
-> NameSet
forall (idR :: Pass) (body :: * -> *).
[LStmtLR GhcRn (GhcPass idR) (Located (body (GhcPass idR)))]
-> NameSet
hs_lstmts [LStmtLR GhcRn (GhcPass idR) (Located (body (GhcPass idR)))]
ss
    hs_stmt (XStmtLR {})          = String -> NameSet
forall a. String -> a
panic "lStmtsImplicits"

    hs_local_binds :: HsLocalBindsLR GhcRn (GhcPass idR) -> NameSet
hs_local_binds (HsValBinds _ val_binds :: HsValBindsLR GhcRn (GhcPass idR)
val_binds) = HsValBindsLR GhcRn (GhcPass idR) -> NameSet
forall (idR :: Pass). HsValBindsLR GhcRn (GhcPass idR) -> NameSet
hsValBindsImplicits HsValBindsLR GhcRn (GhcPass idR)
val_binds
    hs_local_binds (HsIPBinds {})           = NameSet
emptyNameSet
    hs_local_binds (EmptyLocalBinds _)      = NameSet
emptyNameSet
    hs_local_binds (XHsLocalBindsLR _)      = NameSet
emptyNameSet

hsValBindsImplicits :: HsValBindsLR GhcRn (GhcPass idR) -> NameSet
hsValBindsImplicits :: HsValBindsLR GhcRn (GhcPass idR) -> NameSet
hsValBindsImplicits (XValBindsLR (NValBinds binds _))
  = ((RecFlag, LHsBindsLR GhcRn GhcRn) -> NameSet -> NameSet)
-> NameSet -> [(RecFlag, LHsBindsLR GhcRn GhcRn)] -> NameSet
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (NameSet -> NameSet -> NameSet
unionNameSet (NameSet -> NameSet -> NameSet)
-> ((RecFlag, LHsBindsLR GhcRn GhcRn) -> NameSet)
-> (RecFlag, LHsBindsLR GhcRn GhcRn)
-> NameSet
-> NameSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsBindsLR GhcRn GhcRn -> NameSet
forall idR. LHsBindsLR GhcRn idR -> NameSet
lhsBindsImplicits (LHsBindsLR GhcRn GhcRn -> NameSet)
-> ((RecFlag, LHsBindsLR GhcRn GhcRn) -> LHsBindsLR GhcRn GhcRn)
-> (RecFlag, LHsBindsLR GhcRn GhcRn)
-> NameSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RecFlag, LHsBindsLR GhcRn GhcRn) -> LHsBindsLR GhcRn GhcRn
forall a b. (a, b) -> b
snd) NameSet
emptyNameSet [(RecFlag, LHsBindsLR GhcRn GhcRn)]
binds
hsValBindsImplicits (ValBinds _ binds :: LHsBindsLR GhcRn (GhcPass idR)
binds _)
  = LHsBindsLR GhcRn (GhcPass idR) -> NameSet
forall idR. LHsBindsLR GhcRn idR -> NameSet
lhsBindsImplicits LHsBindsLR GhcRn (GhcPass idR)
binds

lhsBindsImplicits :: LHsBindsLR GhcRn idR -> NameSet
lhsBindsImplicits :: LHsBindsLR GhcRn idR -> NameSet
lhsBindsImplicits = (NameSet -> NameSet -> NameSet)
-> (LHsBindLR GhcRn idR -> NameSet)
-> NameSet
-> LHsBindsLR GhcRn idR
-> NameSet
forall r a. (r -> r -> r) -> (a -> r) -> r -> Bag a -> r
foldBag NameSet -> NameSet -> NameSet
unionNameSet (HsBindLR GhcRn idR -> NameSet
forall idR. HsBindLR GhcRn idR -> NameSet
lhs_bind (HsBindLR GhcRn idR -> NameSet)
-> (LHsBindLR GhcRn idR -> HsBindLR GhcRn idR)
-> LHsBindLR GhcRn idR
-> NameSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsBindLR GhcRn idR -> HsBindLR GhcRn idR
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) NameSet
emptyNameSet
  where
    lhs_bind :: HsBindLR GhcRn idR -> NameSet
lhs_bind (PatBind { pat_lhs :: forall idL idR. HsBindLR idL idR -> LPat idL
pat_lhs = LPat GhcRn
lpat }) = LPat GhcRn -> NameSet
lPatImplicits LPat GhcRn
lpat
    lhs_bind _ = NameSet
emptyNameSet

lPatImplicits :: LPat GhcRn -> NameSet
lPatImplicits :: LPat GhcRn -> NameSet
lPatImplicits = LPat GhcRn -> NameSet
hs_lpat
  where
    hs_lpat :: LPat GhcRn -> NameSet
hs_lpat lpat :: LPat GhcRn
lpat = LPat GhcRn -> NameSet
hs_pat (LPat GhcRn -> SrcSpanLess (LPat GhcRn)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LPat GhcRn
lpat)

    hs_lpats :: [LPat GhcRn] -> NameSet
hs_lpats = (LPat GhcRn -> NameSet -> NameSet)
-> NameSet -> [LPat GhcRn] -> NameSet
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\pat :: LPat GhcRn
pat rest :: NameSet
rest -> LPat GhcRn -> NameSet
hs_lpat LPat GhcRn
pat NameSet -> NameSet -> NameSet
`unionNameSet` NameSet
rest) NameSet
emptyNameSet

    hs_pat :: LPat GhcRn -> NameSet
hs_pat (LazyPat _ pat :: LPat GhcRn
pat)      = LPat GhcRn -> NameSet
hs_lpat LPat GhcRn
pat
    hs_pat (BangPat _ pat :: LPat GhcRn
pat)      = LPat GhcRn -> NameSet
hs_lpat LPat GhcRn
pat
    hs_pat (AsPat _ _ pat :: LPat GhcRn
pat)      = LPat GhcRn -> NameSet
hs_lpat LPat GhcRn
pat
    hs_pat (ViewPat _ _ pat :: LPat GhcRn
pat)    = LPat GhcRn -> NameSet
hs_lpat LPat GhcRn
pat
    hs_pat (ParPat _ pat :: LPat GhcRn
pat)       = LPat GhcRn -> NameSet
hs_lpat LPat GhcRn
pat
    hs_pat (ListPat _ pats :: [LPat GhcRn]
pats)     = [LPat GhcRn] -> NameSet
hs_lpats [LPat GhcRn]
pats
    hs_pat (TuplePat _ pats :: [LPat GhcRn]
pats _)  = [LPat GhcRn] -> NameSet
hs_lpats [LPat GhcRn]
pats

    hs_pat (SigPat _ pat :: LPat GhcRn
pat _)     = LPat GhcRn -> NameSet
hs_lpat LPat GhcRn
pat
    hs_pat (CoPat _ _ pat :: LPat GhcRn
pat _)    = LPat GhcRn -> NameSet
hs_pat LPat GhcRn
pat

    hs_pat (ConPatIn _ ps :: HsConPatDetails GhcRn
ps)           = HsConPatDetails GhcRn -> NameSet
details HsConPatDetails GhcRn
ps
    hs_pat (ConPatOut {pat_args :: forall p. LPat p -> HsConPatDetails p
pat_args=HsConPatDetails GhcRn
ps}) = HsConPatDetails GhcRn -> NameSet
details HsConPatDetails GhcRn
ps

    hs_pat _ = NameSet
emptyNameSet

    details :: HsConPatDetails GhcRn -> NameSet
details (PrefixCon ps :: [LPat GhcRn]
ps)   = [LPat GhcRn] -> NameSet
hs_lpats [LPat GhcRn]
ps
    details (RecCon fs :: HsRecFields GhcRn (LPat GhcRn)
fs)      = [LPat GhcRn] -> NameSet
hs_lpats [LPat GhcRn]
explicit NameSet -> NameSet -> NameSet
`unionNameSet` [Name] -> NameSet
mkNameSet ([LPat GhcRn] -> [IdP GhcRn]
forall (p :: Pass). [LPat (GhcPass p)] -> [IdP (GhcPass p)]
collectPatsBinders [LPat GhcRn]
implicit)
      where (explicit :: [LPat GhcRn]
explicit, implicit :: [LPat GhcRn]
implicit) = [Either (LPat GhcRn) (LPat GhcRn)] -> ([LPat GhcRn], [LPat GhcRn])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [if Bool
pat_explicit then LPat GhcRn -> Either (LPat GhcRn) (LPat GhcRn)
forall a b. a -> Either a b
Left LPat GhcRn
pat else LPat GhcRn -> Either (LPat GhcRn) (LPat GhcRn)
forall a b. b -> Either a b
Right LPat GhcRn
pat
                                                    | (i :: Int
i, fld :: LHsRecField GhcRn (LPat GhcRn)
fld) <- [0..] [Int]
-> [LHsRecField GhcRn (LPat GhcRn)]
-> [(Int, LHsRecField GhcRn (LPat GhcRn))]
forall a b. [a] -> [b] -> [(a, b)]
`zip` HsRecFields GhcRn (LPat GhcRn) -> [LHsRecField GhcRn (LPat GhcRn)]
forall p arg. HsRecFields p arg -> [LHsRecField p arg]
rec_flds HsRecFields GhcRn (LPat GhcRn)
fs
                                                    , let pat :: LPat GhcRn
pat = HsRecField' (FieldOcc GhcRn) (LPat GhcRn) -> LPat GhcRn
forall id arg. HsRecField' id arg -> arg
hsRecFieldArg
                                                                     (LHsRecField GhcRn (LPat GhcRn)
-> SrcSpanLess (LHsRecField GhcRn (LPat GhcRn))
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsRecField GhcRn (LPat GhcRn)
fld)
                                                          pat_explicit :: Bool
pat_explicit = Bool -> (Int -> Bool) -> Maybe 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
<) (HsRecFields GhcRn (LPat GhcRn) -> Maybe Int
forall p arg. HsRecFields p arg -> Maybe Int
rec_dotdot HsRecFields GhcRn (LPat GhcRn)
fs)]
    details (InfixCon p1 :: LPat GhcRn
p1 p2 :: LPat GhcRn
p2) = LPat GhcRn -> NameSet
hs_lpat LPat GhcRn
p1 NameSet -> NameSet -> NameSet
`unionNameSet` LPat GhcRn -> NameSet
hs_lpat LPat GhcRn
p2