{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}
module GHC.Rename.Utils (
checkDupRdrNames, checkShadowedRdrNames,
checkDupNames, checkDupAndShadowedNames, dupNamesErr,
checkTupSize, checkCTupSize,
addFvRn, mapFvRn, mapMaybeFvRn,
warnUnusedMatches, warnUnusedTypePatterns,
warnUnusedTopBinds, warnUnusedLocalBinds,
DeprecationWarnings(..), warnIfDeprecated,
checkUnusedRecordWildcard,
badQualBndrErr, typeAppErr, badFieldConErr,
wrapGenSpan, genHsVar, genLHsVar, genHsApp, genHsApps, genHsApps', genHsExpApps,
genLHsApp, genAppType,
genLHsLit, genHsIntegralLit, genHsTyLit, genSimpleConPat,
genVarPat, genWildPat,
genSimpleFunBind, genFunBind,
genHsLamDoExp, genHsCaseAltDoExp, genSimpleMatch, genHsLet,
mkRnSyntaxExpr,
newLocalBndrRn, newLocalBndrsRn,
bindLocalNames, bindLocalNamesFV, delLocalNames,
addNameClashErrRn, mkNameClashErr,
checkInferredVars,
noNestedForallsContextsErr, addNoNestedForallsContextsErr
)
where
import GHC.Prelude hiding (unzip)
import GHC.Core.Type
import GHC.Hs
import GHC.Types.Name.Reader
import GHC.Tc.Errors.Types
import GHC.Tc.Utils.Monad
import GHC.Types.Name
import GHC.Types.Name.Set
import GHC.Types.Name.Env
import GHC.Core.DataCon
import GHC.Types.SrcLoc as SrcLoc
import GHC.Types.SourceFile
import GHC.Types.SourceText ( SourceText(..), IntegralLit )
import GHC.Utils.Outputable
import GHC.Utils.Misc
import GHC.Unit.Module.ModIface
import GHC.Utils.Panic
import GHC.Types.Basic
import GHC.Data.List.SetOps ( removeDupsOn )
import GHC.Data.Maybe ( whenIsJust )
import GHC.Driver.DynFlags
import GHC.Data.FastString
import GHC.Data.Bag ( mapBagM, headMaybe )
import Control.Monad
import GHC.Settings.Constants ( mAX_TUPLE_SIZE, mAX_CTUPLE_SIZE )
import GHC.Unit.Module
import GHC.Unit.Module.Warnings ( WarningTxt(..) )
import GHC.Iface.Load
import qualified GHC.LanguageExtensions as LangExt
import qualified Data.List as List
import qualified Data.List.NonEmpty as NE
import Data.Foldable
import Data.Maybe
newLocalBndrRn :: LocatedN RdrName -> RnM Name
newLocalBndrRn :: LocatedN RdrName -> RnM Name
newLocalBndrRn (L SrcSpanAnnN
loc RdrName
rdr_name)
| Just Name
name <- RdrName -> Maybe Name
isExact_maybe RdrName
rdr_name
= Name -> RnM Name
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return Name
name
| Bool
otherwise
= do { Bool
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (RdrName -> Bool
isUnqual RdrName
rdr_name)
(SrcSpan -> TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErrAt (SrcSpanAnnN -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnN
loc) (RdrName -> TcRnMessage
badQualBndrErr RdrName
rdr_name))
; uniq <- TcRnIf TcGblEnv TcLclEnv Unique
forall gbl lcl. TcRnIf gbl lcl Unique
newUnique
; return (mkInternalName uniq (rdrNameOcc rdr_name) (locA loc)) }
newLocalBndrsRn :: [LocatedN RdrName] -> RnM [Name]
newLocalBndrsRn :: [LocatedN RdrName] -> RnM [Name]
newLocalBndrsRn = (LocatedN RdrName -> RnM Name) -> [LocatedN RdrName] -> RnM [Name]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM LocatedN RdrName -> RnM Name
newLocalBndrRn
bindLocalNames :: [Name] -> RnM a -> RnM a
bindLocalNames :: forall a. [Name] -> RnM a -> RnM a
bindLocalNames [Name]
names
= (TcLclCtxt -> TcLclCtxt)
-> TcRnIf TcGblEnv TcLclEnv a -> TcRnIf TcGblEnv TcLclEnv a
forall gbl a.
(TcLclCtxt -> TcLclCtxt)
-> TcRnIf gbl TcLclEnv a -> TcRnIf gbl TcLclEnv a
updLclCtxt ((TcLclCtxt -> TcLclCtxt)
-> TcRnIf TcGblEnv TcLclEnv a -> TcRnIf TcGblEnv TcLclEnv a)
-> (TcLclCtxt -> TcLclCtxt)
-> TcRnIf TcGblEnv TcLclEnv a
-> TcRnIf TcGblEnv TcLclEnv a
forall a b. (a -> b) -> a -> b
$ \ TcLclCtxt
lcl_env ->
let th_level :: Int
th_level = ThStage -> Int
thLevel (TcLclCtxt -> ThStage
tcl_th_ctxt TcLclCtxt
lcl_env)
th_bndrs' :: NameEnv (TopLevelFlag, Int)
th_bndrs' = NameEnv (TopLevelFlag, Int)
-> [(Name, (TopLevelFlag, Int))] -> NameEnv (TopLevelFlag, Int)
forall a. NameEnv a -> [(Name, a)] -> NameEnv a
extendNameEnvList (TcLclCtxt -> NameEnv (TopLevelFlag, Int)
tcl_th_bndrs TcLclCtxt
lcl_env)
[ (Name
n, (TopLevelFlag
NotTopLevel, Int
th_level)) | Name
n <- [Name]
names ]
rdr_env' :: LocalRdrEnv
rdr_env' = LocalRdrEnv -> [Name] -> LocalRdrEnv
extendLocalRdrEnvList (TcLclCtxt -> LocalRdrEnv
tcl_rdr TcLclCtxt
lcl_env) [Name]
names
in TcLclCtxt
lcl_env { tcl_th_bndrs = th_bndrs'
, tcl_rdr = rdr_env' }
bindLocalNamesFV :: [Name] -> RnM (a, FreeVars) -> RnM (a, FreeVars)
bindLocalNamesFV :: forall a. [Name] -> RnM (a, FreeVars) -> RnM (a, FreeVars)
bindLocalNamesFV [Name]
names RnM (a, FreeVars)
enclosed_scope
= do { (result, fvs) <- [Name] -> RnM (a, FreeVars) -> RnM (a, FreeVars)
forall a. [Name] -> RnM a -> RnM a
bindLocalNames [Name]
names RnM (a, FreeVars)
enclosed_scope
; return (result, delFVs names fvs) }
delLocalNames :: [Name] -> RnM a -> RnM a
delLocalNames :: forall a. [Name] -> RnM a -> RnM a
delLocalNames [Name]
names
= (TcLclCtxt -> TcLclCtxt)
-> TcRnIf TcGblEnv TcLclEnv a -> TcRnIf TcGblEnv TcLclEnv a
forall gbl a.
(TcLclCtxt -> TcLclCtxt)
-> TcRnIf gbl TcLclEnv a -> TcRnIf gbl TcLclEnv a
updLclCtxt ((TcLclCtxt -> TcLclCtxt)
-> TcRnIf TcGblEnv TcLclEnv a -> TcRnIf TcGblEnv TcLclEnv a)
-> (TcLclCtxt -> TcLclCtxt)
-> TcRnIf TcGblEnv TcLclEnv a
-> TcRnIf TcGblEnv TcLclEnv a
forall a b. (a -> b) -> a -> b
$ \ TcLclCtxt
lcl_env ->
let th_bndrs' :: NameEnv (TopLevelFlag, Int)
th_bndrs' = NameEnv (TopLevelFlag, Int)
-> [Name] -> NameEnv (TopLevelFlag, Int)
forall a. NameEnv a -> [Name] -> NameEnv a
delListFromNameEnv (TcLclCtxt -> NameEnv (TopLevelFlag, Int)
tcl_th_bndrs TcLclCtxt
lcl_env) [Name]
names
rdr_env' :: LocalRdrEnv
rdr_env' = LocalRdrEnv -> [OccName] -> LocalRdrEnv
minusLocalRdrEnvList (TcLclCtxt -> LocalRdrEnv
tcl_rdr TcLclCtxt
lcl_env) ((Name -> OccName) -> [Name] -> [OccName]
forall a b. (a -> b) -> [a] -> [b]
map Name -> OccName
forall name. HasOccName name => name -> OccName
occName [Name]
names)
in TcLclCtxt
lcl_env { tcl_th_bndrs = th_bndrs'
, tcl_rdr = rdr_env' }
checkDupRdrNames :: [LocatedN RdrName] -> RnM ()
checkDupRdrNames :: [LocatedN RdrName] -> IOEnv (Env TcGblEnv TcLclEnv) ()
checkDupRdrNames [LocatedN RdrName]
rdr_names_w_loc
= (NonEmpty (LocatedN RdrName) -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> [NonEmpty (LocatedN RdrName)]
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\ NonEmpty (LocatedN RdrName)
ns -> NonEmpty SrcSpan
-> NonEmpty RdrName -> IOEnv (Env TcGblEnv TcLclEnv) ()
dupNamesErr (LocatedN RdrName -> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA (LocatedN RdrName -> SrcSpan)
-> NonEmpty (LocatedN RdrName) -> NonEmpty SrcSpan
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (LocatedN RdrName)
ns) (LocatedN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc (LocatedN RdrName -> RdrName)
-> NonEmpty (LocatedN RdrName) -> NonEmpty RdrName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (LocatedN RdrName)
ns)) [NonEmpty (LocatedN RdrName)]
dups
where
([LocatedN RdrName]
_, [NonEmpty (LocatedN RdrName)]
dups) = (LocatedN RdrName -> RdrName)
-> [LocatedN RdrName]
-> ([LocatedN RdrName], [NonEmpty (LocatedN RdrName)])
forall b a. Ord b => (a -> b) -> [a] -> ([a], [NonEmpty a])
removeDupsOn LocatedN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc [LocatedN RdrName]
rdr_names_w_loc
checkDupNames :: [Name] -> RnM ()
checkDupNames :: [Name] -> IOEnv (Env TcGblEnv TcLclEnv) ()
checkDupNames [Name]
names = [Name] -> IOEnv (Env TcGblEnv TcLclEnv) ()
check_dup_names ((Name -> Bool) -> [Name] -> [Name]
forall a. (a -> Bool) -> [a] -> [a]
filterOut Name -> Bool
isSystemName [Name]
names)
check_dup_names :: [Name] -> RnM ()
check_dup_names :: [Name] -> IOEnv (Env TcGblEnv TcLclEnv) ()
check_dup_names [Name]
names
= (NonEmpty Name -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> [NonEmpty Name] -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\ NonEmpty Name
ns -> NonEmpty SrcSpan
-> NonEmpty RdrName -> IOEnv (Env TcGblEnv TcLclEnv) ()
dupNamesErr (Name -> SrcSpan
nameSrcSpan (Name -> SrcSpan) -> NonEmpty Name -> NonEmpty SrcSpan
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty Name
ns) (Name -> RdrName
forall thing. NamedThing thing => thing -> RdrName
getRdrName (Name -> RdrName) -> NonEmpty Name -> NonEmpty RdrName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty Name
ns)) [NonEmpty Name]
dups
where
([Name]
_, [NonEmpty Name]
dups) = (Name -> OccName) -> [Name] -> ([Name], [NonEmpty Name])
forall b a. Ord b => (a -> b) -> [a] -> ([a], [NonEmpty a])
removeDupsOn Name -> OccName
nameOccName [Name]
names
checkShadowedRdrNames :: [LocatedN RdrName] -> RnM ()
checkShadowedRdrNames :: [LocatedN RdrName] -> IOEnv (Env TcGblEnv TcLclEnv) ()
checkShadowedRdrNames [LocatedN RdrName]
loc_rdr_names
= do { envs <- TcRn (GlobalRdrEnv, LocalRdrEnv)
getRdrEnvs
; checkShadowedOccs envs get_loc_occ filtered_rdrs }
where
filtered_rdrs :: [LocatedN RdrName]
filtered_rdrs = (LocatedN RdrName -> Bool)
-> [LocatedN RdrName] -> [LocatedN RdrName]
forall a. (a -> Bool) -> [a] -> [a]
filterOut (RdrName -> Bool
isExact (RdrName -> Bool)
-> (LocatedN RdrName -> RdrName) -> LocatedN RdrName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocatedN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc) [LocatedN RdrName]
loc_rdr_names
get_loc_occ :: GenLocated a RdrName -> (SrcSpan, OccName)
get_loc_occ (L a
loc RdrName
rdr) = (a -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA a
loc,RdrName -> OccName
rdrNameOcc RdrName
rdr)
checkDupAndShadowedNames :: (GlobalRdrEnv, LocalRdrEnv) -> [Name] -> RnM ()
checkDupAndShadowedNames :: (GlobalRdrEnv, LocalRdrEnv)
-> [Name] -> IOEnv (Env TcGblEnv TcLclEnv) ()
checkDupAndShadowedNames (GlobalRdrEnv, LocalRdrEnv)
envs [Name]
names
= do { [Name] -> IOEnv (Env TcGblEnv TcLclEnv) ()
check_dup_names [Name]
filtered_names
; (GlobalRdrEnv, LocalRdrEnv)
-> (Name -> (SrcSpan, OccName))
-> [Name]
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a.
(GlobalRdrEnv, LocalRdrEnv)
-> (a -> (SrcSpan, OccName))
-> [a]
-> IOEnv (Env TcGblEnv TcLclEnv) ()
checkShadowedOccs (GlobalRdrEnv, LocalRdrEnv)
envs Name -> (SrcSpan, OccName)
get_loc_occ [Name]
filtered_names }
where
filtered_names :: [Name]
filtered_names = (Name -> Bool) -> [Name] -> [Name]
forall a. (a -> Bool) -> [a] -> [a]
filterOut Name -> Bool
isSystemName [Name]
names
get_loc_occ :: Name -> (SrcSpan, OccName)
get_loc_occ Name
name = (Name -> SrcSpan
nameSrcSpan Name
name, Name -> OccName
nameOccName Name
name)
checkShadowedOccs :: (GlobalRdrEnv, LocalRdrEnv)
-> (a -> (SrcSpan, OccName))
-> [a] -> RnM ()
checkShadowedOccs :: forall a.
(GlobalRdrEnv, LocalRdrEnv)
-> (a -> (SrcSpan, OccName))
-> [a]
-> IOEnv (Env TcGblEnv TcLclEnv) ()
checkShadowedOccs (GlobalRdrEnv
global_env,LocalRdrEnv
local_env) a -> (SrcSpan, OccName)
get_loc_occ [a]
ns
= WarningFlag
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall gbl lcl.
WarningFlag -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
whenWOptM WarningFlag
Opt_WarnNameShadowing (IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$
do { String -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn String
"checkShadowedOccs:shadow" ([(SrcSpan, OccName)] -> SDoc
forall a. Outputable a => a -> SDoc
ppr ((a -> (SrcSpan, OccName)) -> [a] -> [(SrcSpan, OccName)]
forall a b. (a -> b) -> [a] -> [b]
map a -> (SrcSpan, OccName)
get_loc_occ [a]
ns))
; (a -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> [a] -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ a -> IOEnv (Env TcGblEnv TcLclEnv) ()
check_shadow [a]
ns }
where
check_shadow :: a -> IOEnv (Env TcGblEnv TcLclEnv) ()
check_shadow a
n
| OccName -> Bool
startsWithUnderscore OccName
occ = () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Just Name
n <- Maybe Name
mb_local = ShadowedNameProvenance -> IOEnv (Env TcGblEnv TcLclEnv) ()
complain (SrcLoc -> ShadowedNameProvenance
ShadowedNameProvenanceLocal (Name -> SrcLoc
nameSrcLoc Name
n))
| Bool
otherwise = do { gres' <- (GlobalRdrElt -> IOEnv (Env TcGblEnv TcLclEnv) Bool)
-> [GlobalRdrElt] -> IOEnv (Env TcGblEnv TcLclEnv) [GlobalRdrElt]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM GlobalRdrElt -> IOEnv (Env TcGblEnv TcLclEnv) Bool
is_shadowed_gre [GlobalRdrElt]
gres
; when (not . null $ gres') $ complain (ShadowedNameProvenanceGlobal gres') }
where
(SrcSpan
loc,OccName
occ) = a -> (SrcSpan, OccName)
get_loc_occ a
n
mb_local :: Maybe Name
mb_local = LocalRdrEnv -> OccName -> Maybe Name
lookupLocalRdrOcc LocalRdrEnv
local_env OccName
occ
gres :: [GlobalRdrElt]
gres = GlobalRdrEnv -> LookupGRE GREInfo -> [GlobalRdrElt]
forall info.
GlobalRdrEnvX info -> LookupGRE info -> [GlobalRdrEltX info]
lookupGRE GlobalRdrEnv
global_env (RdrName -> WhichGREs GREInfo -> LookupGRE GREInfo
forall info. RdrName -> WhichGREs info -> LookupGRE info
LookupRdrName (OccName -> RdrName
mkRdrUnqual OccName
occ) (FieldsOrSelectors -> WhichGREs GREInfo
RelevantGREsFOS FieldsOrSelectors
WantNormal))
complain :: ShadowedNameProvenance -> IOEnv (Env TcGblEnv TcLclEnv) ()
complain ShadowedNameProvenance
provenance = SrcSpan -> TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
addDiagnosticAt SrcSpan
loc (OccName -> ShadowedNameProvenance -> TcRnMessage
TcRnShadowedName OccName
occ ShadowedNameProvenance
provenance)
is_shadowed_gre :: GlobalRdrElt -> RnM Bool
is_shadowed_gre :: GlobalRdrElt -> IOEnv (Env TcGblEnv TcLclEnv) Bool
is_shadowed_gre GlobalRdrElt
gre | GlobalRdrElt -> Bool
forall info. GlobalRdrEltX info -> Bool
isRecFldGRE GlobalRdrElt
gre
= do { dflags <- IOEnv (Env TcGblEnv TcLclEnv) DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
; return $ not (xopt LangExt.NamedFieldPuns dflags
|| xopt LangExt.RecordWildCards dflags) }
is_shadowed_gre GlobalRdrElt
_other = Bool -> IOEnv (Env TcGblEnv TcLclEnv) Bool
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
checkInferredVars :: HsDocContext
-> LHsSigType GhcPs
-> RnM ()
checkInferredVars :: HsDocContext
-> LHsSigType GhcPs -> IOEnv (Env TcGblEnv TcLclEnv) ()
checkInferredVars HsDocContext
ctxt LHsSigType GhcPs
ty =
let bndrs :: [HsTyVarBndr Specificity GhcPs]
bndrs = LHsSigType GhcPs -> [HsTyVarBndr Specificity GhcPs]
sig_ty_bndrs LHsSigType GhcPs
ty
in case (HsTyVarBndr Specificity GhcPs -> Bool)
-> [HsTyVarBndr Specificity GhcPs]
-> [HsTyVarBndr Specificity GhcPs]
forall a. (a -> Bool) -> [a] -> [a]
filter (Specificity -> Specificity -> Bool
forall a. Eq a => a -> a -> Bool
(==) Specificity
InferredSpec (Specificity -> Bool)
-> (HsTyVarBndr Specificity GhcPs -> Specificity)
-> HsTyVarBndr Specificity GhcPs
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsTyVarBndr Specificity GhcPs -> Specificity
forall flag (pass :: Pass). HsTyVarBndr flag (GhcPass pass) -> flag
hsTyVarBndrFlag) [HsTyVarBndr Specificity GhcPs]
bndrs of
[] -> () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
HsTyVarBndr Specificity GhcPs
iv : [HsTyVarBndr Specificity GhcPs]
ivs -> TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErr (TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$
HsDocContext -> TcRnMessage -> TcRnMessage
TcRnWithHsDocContext HsDocContext
ctxt (TcRnMessage -> TcRnMessage) -> TcRnMessage -> TcRnMessage
forall a b. (a -> b) -> a -> b
$
NonEmpty (HsTyVarBndr Specificity GhcPs) -> TcRnMessage
TcRnIllegalInferredTyVars (HsTyVarBndr Specificity GhcPs
iv HsTyVarBndr Specificity GhcPs
-> [HsTyVarBndr Specificity GhcPs]
-> NonEmpty (HsTyVarBndr Specificity GhcPs)
forall a. a -> [a] -> NonEmpty a
NE.:| [HsTyVarBndr Specificity GhcPs]
ivs)
where
sig_ty_bndrs :: LHsSigType GhcPs -> [HsTyVarBndr Specificity GhcPs]
sig_ty_bndrs :: LHsSigType GhcPs -> [HsTyVarBndr Specificity GhcPs]
sig_ty_bndrs (L SrcSpanAnnA
_ (HsSig{sig_bndrs :: forall pass. HsSigType pass -> HsOuterSigTyVarBndrs pass
sig_bndrs = HsOuterSigTyVarBndrs GhcPs
outer_bndrs}))
= (GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)
-> HsTyVarBndr Specificity GhcPs)
-> [GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)]
-> [HsTyVarBndr Specificity GhcPs]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)
-> HsTyVarBndr Specificity GhcPs
forall l e. GenLocated l e -> e
unLoc (HsOuterSigTyVarBndrs GhcPs
-> [LHsTyVarBndr Specificity (NoGhcTc GhcPs)]
forall flag (p :: Pass).
HsOuterTyVarBndrs flag (GhcPass p)
-> [LHsTyVarBndr flag (NoGhcTc (GhcPass p))]
hsOuterExplicitBndrs HsOuterSigTyVarBndrs GhcPs
outer_bndrs)
noNestedForallsContextsErr :: NestedForallsContextsIn
-> LHsType GhcRn
-> Maybe (SrcSpan, TcRnMessage)
noNestedForallsContextsErr :: NestedForallsContextsIn
-> LHsType GhcRn -> Maybe (SrcSpan, TcRnMessage)
noNestedForallsContextsErr NestedForallsContextsIn
what LHsType GhcRn
lty =
case LHsType GhcRn -> LHsType GhcRn
forall (p :: Pass). LHsType (GhcPass p) -> LHsType (GhcPass p)
ignoreParens LHsType GhcRn
lty of
L SrcSpanAnnA
l (HsForAllTy { hst_tele :: forall pass. HsType pass -> HsForAllTelescope pass
hst_tele = HsForAllTelescope GhcRn
tele })
| HsForAllVis{} <- HsForAllTelescope GhcRn
tele
-> (SrcSpan, TcRnMessage) -> Maybe (SrcSpan, TcRnMessage)
forall a. a -> Maybe a
Just (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
l, Maybe Type -> TcRnMessage
TcRnVDQInTermType Maybe Type
forall a. Maybe a
Nothing)
| HsForAllInvis{} <- HsForAllTelescope GhcRn
tele
-> (SrcSpan, TcRnMessage) -> Maybe (SrcSpan, TcRnMessage)
forall a. a -> Maybe a
Just (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
l, TcRnMessage
nested_foralls_contexts_err)
L SrcSpanAnnA
l (HsQualTy {})
-> (SrcSpan, TcRnMessage) -> Maybe (SrcSpan, TcRnMessage)
forall a. a -> Maybe a
Just (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
l, TcRnMessage
nested_foralls_contexts_err)
LHsType GhcRn
_ -> Maybe (SrcSpan, TcRnMessage)
forall a. Maybe a
Nothing
where
nested_foralls_contexts_err :: TcRnMessage
nested_foralls_contexts_err =
NestedForallsContextsIn -> TcRnMessage
TcRnNestedForallsContexts NestedForallsContextsIn
what
addNoNestedForallsContextsErr :: HsDocContext
-> NestedForallsContextsIn
-> LHsType GhcRn
-> RnM ()
addNoNestedForallsContextsErr :: HsDocContext
-> NestedForallsContextsIn
-> LHsType GhcRn
-> IOEnv (Env TcGblEnv TcLclEnv) ()
addNoNestedForallsContextsErr HsDocContext
ctxt NestedForallsContextsIn
what LHsType GhcRn
lty =
Maybe (SrcSpan, TcRnMessage)
-> ((SrcSpan, TcRnMessage) -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenIsJust (NestedForallsContextsIn
-> LHsType GhcRn -> Maybe (SrcSpan, TcRnMessage)
noNestedForallsContextsErr NestedForallsContextsIn
what LHsType GhcRn
lty) (((SrcSpan, TcRnMessage) -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ())
-> ((SrcSpan, TcRnMessage) -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ \(SrcSpan
l, TcRnMessage
err_msg) ->
SrcSpan -> TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErrAt SrcSpan
l (TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ HsDocContext -> TcRnMessage -> TcRnMessage
TcRnWithHsDocContext HsDocContext
ctxt TcRnMessage
err_msg
addFvRn :: FreeVars -> RnM (thing, FreeVars) -> RnM (thing, FreeVars)
addFvRn :: forall thing.
FreeVars -> RnM (thing, FreeVars) -> RnM (thing, FreeVars)
addFvRn FreeVars
fvs1 RnM (thing, FreeVars)
thing_inside = do { (res, fvs2) <- RnM (thing, FreeVars)
thing_inside
; return (res, fvs1 `plusFV` fvs2) }
mapFvRn :: Traversable f => (a -> RnM (b, FreeVars)) -> f a -> RnM (f b, FreeVars)
mapFvRn :: forall (f :: * -> *) a b.
Traversable f =>
(a -> RnM (b, FreeVars)) -> f a -> RnM (f b, FreeVars)
mapFvRn a -> RnM (b, FreeVars)
f f a
xs = do
stuff <- (a -> RnM (b, FreeVars))
-> f a -> IOEnv (Env TcGblEnv TcLclEnv) (f (b, FreeVars))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> f a -> m (f b)
mapM a -> RnM (b, FreeVars)
f f a
xs
case unzip stuff of
(f b
ys, f FreeVars
fvs_s) -> (f b, FreeVars) -> IOEnv (Env TcGblEnv TcLclEnv) (f b, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (f b
ys, (FreeVars -> FreeVars -> FreeVars)
-> FreeVars -> f FreeVars -> FreeVars
forall b a. (b -> a -> b) -> b -> f a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((FreeVars -> FreeVars -> FreeVars)
-> FreeVars -> FreeVars -> FreeVars
forall a b c. (a -> b -> c) -> b -> a -> c
flip FreeVars -> FreeVars -> FreeVars
plusFV) FreeVars
emptyFVs f FreeVars
fvs_s)
{-# SPECIALIZE mapFvRn :: (a -> RnM (b, FreeVars)) -> [a] -> RnM ([b], FreeVars) #-}
unzip :: Functor f => f (a, b) -> (f a, f b)
unzip :: forall (f :: * -> *) a b. Functor f => f (a, b) -> (f a, f b)
unzip = \ f (a, b)
xs -> (((a, b) -> a) -> f (a, b) -> f a
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, b) -> a
forall a b. (a, b) -> a
fst f (a, b)
xs, ((a, b) -> b) -> f (a, b) -> f b
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, b) -> b
forall a b. (a, b) -> b
snd f (a, b)
xs)
{-# NOINLINE [1] unzip #-}
{-# RULES "unzip/List" unzip = List.unzip #-}
mapMaybeFvRn :: (a -> RnM (b, FreeVars)) -> Maybe a -> RnM (Maybe b, FreeVars)
mapMaybeFvRn :: forall a b.
(a -> RnM (b, FreeVars)) -> Maybe a -> RnM (Maybe b, FreeVars)
mapMaybeFvRn a -> RnM (b, FreeVars)
_ Maybe a
Nothing = (Maybe b, FreeVars)
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe b, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe b
forall a. Maybe a
Nothing, FreeVars
emptyFVs)
mapMaybeFvRn a -> RnM (b, FreeVars)
f (Just a
x) = do { (y, fvs) <- a -> RnM (b, FreeVars)
f a
x; return (Just y, fvs) }
warnUnusedTopBinds :: [GlobalRdrElt] -> RnM ()
warnUnusedTopBinds :: [GlobalRdrElt] -> IOEnv (Env TcGblEnv TcLclEnv) ()
warnUnusedTopBinds [GlobalRdrElt]
gres
= WarningFlag
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall gbl lcl.
WarningFlag -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
whenWOptM WarningFlag
Opt_WarnUnusedTopBinds
(IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ do env <- TcRnIf TcGblEnv TcLclEnv TcGblEnv
forall gbl lcl. TcRnIf gbl lcl gbl
getGblEnv
let isBoot = HscSource -> Bool
isHsBootFile (HscSource -> Bool) -> HscSource -> Bool
forall a b. (a -> b) -> a -> b
$ TcGblEnv -> HscSource
tcg_src TcGblEnv
env
let noParent GlobalRdrEltX info
gre = case GlobalRdrEltX info -> Parent
forall info. GlobalRdrEltX info -> Parent
greParent GlobalRdrEltX info
gre of
Parent
NoParent -> Bool
True
Parent
_ -> Bool
False
gres' = if Bool
isBoot then (GlobalRdrElt -> Bool) -> [GlobalRdrElt] -> [GlobalRdrElt]
forall a. (a -> Bool) -> [a] -> [a]
filter GlobalRdrElt -> Bool
forall info. GlobalRdrEltX info -> Bool
noParent [GlobalRdrElt]
gres
else [GlobalRdrElt]
gres
warnUnusedGREs gres'
checkUnusedRecordWildcard :: SrcSpan
-> FreeVars
-> Maybe [ImplicitFieldBinders]
-> RnM ()
checkUnusedRecordWildcard :: SrcSpan
-> FreeVars
-> Maybe [ImplicitFieldBinders]
-> IOEnv (Env TcGblEnv TcLclEnv) ()
checkUnusedRecordWildcard SrcSpan
_ FreeVars
_ Maybe [ImplicitFieldBinders]
Nothing = () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
checkUnusedRecordWildcard SrcSpan
loc FreeVars
fvs (Just [ImplicitFieldBinders]
dotdot_fields_binders)
= SrcSpan
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a. SrcSpan -> TcRn a -> TcRn a
setSrcSpan SrcSpan
loc (IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ case (ImplicitFieldBinders -> [Name])
-> [ImplicitFieldBinders] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ImplicitFieldBinders -> [Name]
implFlBndr_binders [ImplicitFieldBinders]
dotdot_fields_binders of
[] -> IOEnv (Env TcGblEnv TcLclEnv) ()
warnRedundantRecordWildcard
[Name]
dotdot_names
-> do
[Name] -> FreeVars -> IOEnv (Env TcGblEnv TcLclEnv) ()
warnUnusedRecordWildcard [Name]
dotdot_names FreeVars
fvs
[ImplicitFieldBinders]
-> FreeVars -> IOEnv (Env TcGblEnv TcLclEnv) ()
deprecateUsedRecordWildcard [ImplicitFieldBinders]
dotdot_fields_binders FreeVars
fvs
warnRedundantRecordWildcard :: RnM ()
warnRedundantRecordWildcard :: IOEnv (Env TcGblEnv TcLclEnv) ()
warnRedundantRecordWildcard = TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
addDiagnostic TcRnMessage
TcRnRedundantRecordWildcard
warnUnusedRecordWildcard :: [Name] -> FreeVars -> RnM ()
warnUnusedRecordWildcard :: [Name] -> FreeVars -> IOEnv (Env TcGblEnv TcLclEnv) ()
warnUnusedRecordWildcard [Name]
ns FreeVars
used_names = do
let used :: [Name]
used = (Name -> Bool) -> [Name] -> [Name]
forall a. (a -> Bool) -> [a] -> [a]
filter (Name -> FreeVars -> Bool
`elemNameSet` FreeVars
used_names) [Name]
ns
String -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn String
"warnUnused" ([Name] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Name]
ns SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ FreeVars -> SDoc
forall a. Outputable a => a -> SDoc
ppr FreeVars
used_names SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ [Name] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Name]
used)
Bool -> TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
warnIf ([Name] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Name]
used) ([Name] -> TcRnMessage
TcRnUnusedRecordWildcard [Name]
ns)
deprecateUsedRecordWildcard :: [ImplicitFieldBinders]
-> FreeVars -> RnM ()
deprecateUsedRecordWildcard :: [ImplicitFieldBinders]
-> FreeVars -> IOEnv (Env TcGblEnv TcLclEnv) ()
deprecateUsedRecordWildcard [ImplicitFieldBinders]
dotdot_fields_binders FreeVars
fvs
= (ImplicitFieldBinders -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> [ImplicitFieldBinders] -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ImplicitFieldBinders -> IOEnv (Env TcGblEnv TcLclEnv) ()
depr_field_binders [ImplicitFieldBinders]
dotdot_fields_binders
where
depr_field_binders :: ImplicitFieldBinders -> IOEnv (Env TcGblEnv TcLclEnv) ()
depr_field_binders (ImplicitFieldBinders {[Name]
Name
implFlBndr_binders :: ImplicitFieldBinders -> [Name]
implFlBndr_field :: Name
implFlBndr_binders :: [Name]
implFlBndr_field :: ImplicitFieldBinders -> Name
..})
= Bool
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Name] -> FreeVars
mkFVs [Name]
implFlBndr_binders FreeVars -> FreeVars -> Bool
`intersectsFVs` FreeVars
fvs) (IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ do
env <- TcRn GlobalRdrEnv
getGlobalRdrEnv
let gre = Maybe GlobalRdrElt -> GlobalRdrElt
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe GlobalRdrElt -> GlobalRdrElt)
-> Maybe GlobalRdrElt -> GlobalRdrElt
forall a b. (a -> b) -> a -> b
$ GlobalRdrEnv -> Name -> Maybe GlobalRdrElt
forall info.
Outputable info =>
GlobalRdrEnvX info -> Name -> Maybe (GlobalRdrEltX info)
lookupGRE_Name GlobalRdrEnv
env Name
implFlBndr_field
warnIfDeprecated AllDeprecationWarnings [gre]
warnUnusedLocalBinds, warnUnusedMatches, warnUnusedTypePatterns
:: [Name] -> FreeVars -> RnM ()
warnUnusedLocalBinds :: [Name] -> FreeVars -> IOEnv (Env TcGblEnv TcLclEnv) ()
warnUnusedLocalBinds = UnusedNameProv
-> [Name] -> FreeVars -> IOEnv (Env TcGblEnv TcLclEnv) ()
check_unused UnusedNameProv
UnusedNameLocalBind
warnUnusedMatches :: [Name] -> FreeVars -> IOEnv (Env TcGblEnv TcLclEnv) ()
warnUnusedMatches = UnusedNameProv
-> [Name] -> FreeVars -> IOEnv (Env TcGblEnv TcLclEnv) ()
check_unused UnusedNameProv
UnusedNameMatch
warnUnusedTypePatterns :: [Name] -> FreeVars -> IOEnv (Env TcGblEnv TcLclEnv) ()
warnUnusedTypePatterns = UnusedNameProv
-> [Name] -> FreeVars -> IOEnv (Env TcGblEnv TcLclEnv) ()
check_unused UnusedNameProv
UnusedNameTypePattern
check_unused :: UnusedNameProv -> [Name] -> FreeVars -> RnM ()
check_unused :: UnusedNameProv
-> [Name] -> FreeVars -> IOEnv (Env TcGblEnv TcLclEnv) ()
check_unused UnusedNameProv
prov [Name]
bound_names FreeVars
used_names
= UnusedNameProv -> [Name] -> IOEnv (Env TcGblEnv TcLclEnv) ()
warnUnused UnusedNameProv
prov ((Name -> Bool) -> [Name] -> [Name]
forall a. (a -> Bool) -> [a] -> [a]
filterOut (Name -> FreeVars -> Bool
`elemNameSet` FreeVars
used_names) [Name]
bound_names)
data DeprecationWarnings
= NoDeprecationWarnings
| ExportDeprecationWarnings
| AllDeprecationWarnings
warnIfDeprecated :: DeprecationWarnings -> [GlobalRdrElt] -> RnM ()
warnIfDeprecated :: DeprecationWarnings
-> [GlobalRdrElt] -> IOEnv (Env TcGblEnv TcLclEnv) ()
warnIfDeprecated DeprecationWarnings
NoDeprecationWarnings [GlobalRdrElt]
_ = () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
warnIfDeprecated DeprecationWarnings
opt [GlobalRdrElt]
gres = do
this_mod <- IOEnv (Env TcGblEnv TcLclEnv) Module
forall (m :: * -> *). HasModule m => m Module
getModule
let external_gres
= (GlobalRdrElt -> Bool) -> [GlobalRdrElt] -> [GlobalRdrElt]
forall a. (a -> Bool) -> [a] -> [a]
filterOut (Module -> Name -> Bool
nameIsLocalOrFrom Module
this_mod (Name -> Bool) -> (GlobalRdrElt -> Name) -> GlobalRdrElt -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName) [GlobalRdrElt]
gres
mapM_ (\GlobalRdrElt
gre -> GlobalRdrElt -> IOEnv (Env TcGblEnv TcLclEnv) ()
warnIfExportDeprecated GlobalRdrElt
gre IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b.
IOEnv (Env TcGblEnv TcLclEnv) a
-> IOEnv (Env TcGblEnv TcLclEnv) b
-> IOEnv (Env TcGblEnv TcLclEnv) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GlobalRdrElt -> IOEnv (Env TcGblEnv TcLclEnv) ()
maybeWarnDeclDepr GlobalRdrElt
gre) external_gres
where
maybeWarnDeclDepr :: GlobalRdrElt -> IOEnv (Env TcGblEnv TcLclEnv) ()
maybeWarnDeclDepr = case DeprecationWarnings
opt of
DeprecationWarnings
ExportDeprecationWarnings -> IOEnv (Env TcGblEnv TcLclEnv) ()
-> GlobalRdrElt -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. a -> b -> a
const (IOEnv (Env TcGblEnv TcLclEnv) ()
-> GlobalRdrElt -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> GlobalRdrElt
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
DeprecationWarnings
AllDeprecationWarnings -> GlobalRdrElt -> IOEnv (Env TcGblEnv TcLclEnv) ()
warnIfDeclDeprecated
warnIfDeclDeprecated :: GlobalRdrElt -> RnM ()
warnIfDeclDeprecated :: GlobalRdrElt -> IOEnv (Env TcGblEnv TcLclEnv) ()
warnIfDeclDeprecated gre :: GlobalRdrElt
gre@(GRE { gre_imp :: forall info. GlobalRdrEltX info -> Bag ImportSpec
gre_imp = Bag ImportSpec
iss })
| Just ImportSpec
imp_spec <- Bag ImportSpec -> Maybe ImportSpec
forall a. Bag a -> Maybe a
headMaybe Bag ImportSpec
iss
= do { dflags <- IOEnv (Env TcGblEnv TcLclEnv) DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
; when (wopt_any_custom dflags) $
do { iface <- loadInterfaceForName doc name
; case lookupImpDeclDeprec iface gre of
Just WarningTxt GhcRn
deprText -> TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
addDiagnostic (TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$
PragmaWarningInfo -> WarningTxt GhcRn -> TcRnMessage
TcRnPragmaWarning
PragmaWarningName
{ pwarn_occname :: OccName
pwarn_occname = OccName
occ
, pwarn_impmod :: ModuleName
pwarn_impmod = ImportSpec -> ModuleName
importSpecModule ImportSpec
imp_spec
, pwarn_declmod :: ModuleName
pwarn_declmod = ModuleName
definedMod }
WarningTxt GhcRn
deprText
Maybe (WarningTxt GhcRn)
Nothing -> () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return () } }
| Bool
otherwise
= () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
where
occ :: OccName
occ = GlobalRdrElt -> OccName
forall info. GlobalRdrEltX info -> OccName
greOccName GlobalRdrElt
gre
name :: Name
name = GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName GlobalRdrElt
gre
definedMod :: ModuleName
definedMod = Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName (Module -> ModuleName) -> Module -> ModuleName
forall a b. (a -> b) -> a -> b
$ Bool -> SDoc -> Module -> Module
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (Name -> Bool
isExternalName Name
name) (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name) (HasDebugCallStack => Name -> Module
Name -> Module
nameModule Name
name)
doc :: SDoc
doc = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The name" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr OccName
occ) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is mentioned explicitly"
lookupImpDeclDeprec :: ModIface -> GlobalRdrElt -> Maybe (WarningTxt GhcRn)
lookupImpDeclDeprec :: ModIface -> GlobalRdrElt -> Maybe (WarningTxt GhcRn)
lookupImpDeclDeprec ModIface
iface GlobalRdrElt
gre
= ModIfaceBackend -> OccName -> Maybe (WarningTxt GhcRn)
mi_decl_warn_fn (ModIface -> IfaceBackendExts 'ModIfaceFinal
forall (phase :: ModIfacePhase).
ModIface_ phase -> IfaceBackendExts phase
mi_final_exts ModIface
iface) (GlobalRdrElt -> OccName
forall info. GlobalRdrEltX info -> OccName
greOccName GlobalRdrElt
gre) Maybe (WarningTxt GhcRn)
-> Maybe (WarningTxt GhcRn) -> Maybe (WarningTxt GhcRn)
forall a. Maybe a -> Maybe a -> Maybe a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
case GlobalRdrElt -> Parent
forall info. GlobalRdrEltX info -> Parent
greParent GlobalRdrElt
gre of
ParentIs Name
p -> ModIfaceBackend -> OccName -> Maybe (WarningTxt GhcRn)
mi_decl_warn_fn (ModIface -> IfaceBackendExts 'ModIfaceFinal
forall (phase :: ModIfacePhase).
ModIface_ phase -> IfaceBackendExts phase
mi_final_exts ModIface
iface) (Name -> OccName
nameOccName Name
p)
Parent
NoParent -> Maybe (WarningTxt GhcRn)
forall a. Maybe a
Nothing
warnIfExportDeprecated :: GlobalRdrElt -> RnM ()
warnIfExportDeprecated :: GlobalRdrElt -> IOEnv (Env TcGblEnv TcLclEnv) ()
warnIfExportDeprecated gre :: GlobalRdrElt
gre@(GRE { gre_imp :: forall info. GlobalRdrEltX info -> Bag ImportSpec
gre_imp = Bag ImportSpec
iss })
= do { mod_warn_mbs <- (ImportSpec
-> IOEnv
(Env TcGblEnv TcLclEnv) (Maybe (ModuleName, WarningTxt GhcRn)))
-> Bag ImportSpec
-> IOEnv
(Env TcGblEnv TcLclEnv)
(Bag (Maybe (ModuleName, WarningTxt GhcRn)))
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Bag a -> m (Bag b)
mapBagM ImportSpec
-> IOEnv
(Env TcGblEnv TcLclEnv) (Maybe (ModuleName, WarningTxt GhcRn))
process_import_spec Bag ImportSpec
iss
; for_ (sequence mod_warn_mbs) $ mapM
$ \(ModuleName
importing_mod, WarningTxt GhcRn
warn_txt) -> TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
addDiagnostic (TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$
PragmaWarningInfo -> WarningTxt GhcRn -> TcRnMessage
TcRnPragmaWarning
PragmaWarningExport
{ pwarn_occname :: OccName
pwarn_occname = OccName
occ
, pwarn_impmod :: ModuleName
pwarn_impmod = ModuleName
importing_mod }
WarningTxt GhcRn
warn_txt }
where
occ :: OccName
occ = GlobalRdrElt -> OccName
forall info. GlobalRdrEltX info -> OccName
greOccName GlobalRdrElt
gre
name :: Name
name = GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName GlobalRdrElt
gre
doc :: SDoc
doc = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The name" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr OccName
occ) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is mentioned explicitly"
process_import_spec :: ImportSpec -> RnM (Maybe (ModuleName, WarningTxt GhcRn))
process_import_spec :: ImportSpec
-> IOEnv
(Env TcGblEnv TcLclEnv) (Maybe (ModuleName, WarningTxt GhcRn))
process_import_spec ImportSpec
is = do
let mod :: Module
mod = ImpDeclSpec -> Module
is_mod (ImpDeclSpec -> Module) -> ImpDeclSpec -> Module
forall a b. (a -> b) -> a -> b
$ ImportSpec -> ImpDeclSpec
is_decl ImportSpec
is
iface <- SDoc -> Module -> TcRn ModIface
loadInterfaceForModule SDoc
doc Module
mod
let mb_warn_txt = ModIfaceBackend -> Name -> Maybe (WarningTxt GhcRn)
mi_export_warn_fn (ModIface -> IfaceBackendExts 'ModIfaceFinal
forall (phase :: ModIfacePhase).
ModIface_ phase -> IfaceBackendExts phase
mi_final_exts ModIface
iface) Name
name
return $ (moduleName mod, ) <$> mb_warn_txt
warnUnusedGREs :: [GlobalRdrElt] -> RnM ()
warnUnusedGREs :: [GlobalRdrElt] -> IOEnv (Env TcGblEnv TcLclEnv) ()
warnUnusedGREs [GlobalRdrElt]
gres = (GlobalRdrElt -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> [GlobalRdrElt] -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ GlobalRdrElt -> IOEnv (Env TcGblEnv TcLclEnv) ()
warnUnusedGRE [GlobalRdrElt]
gres
warnUnused :: UnusedNameProv -> [Name] -> RnM ()
warnUnused :: UnusedNameProv -> [Name] -> IOEnv (Env TcGblEnv TcLclEnv) ()
warnUnused UnusedNameProv
prov [Name]
names =
(Name -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> [Name] -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\ Name
nm -> UnusedNameProv
-> Name -> OccName -> IOEnv (Env TcGblEnv TcLclEnv) ()
warnUnused1 UnusedNameProv
prov Name
nm (Name -> OccName
nameOccName Name
nm)) [Name]
names
warnUnused1 :: UnusedNameProv -> Name -> OccName -> RnM ()
warnUnused1 :: UnusedNameProv
-> Name -> OccName -> IOEnv (Env TcGblEnv TcLclEnv) ()
warnUnused1 UnusedNameProv
prov Name
child OccName
child_occ
= Bool
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Name -> OccName -> Bool
reportable Name
child OccName
child_occ) (IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$
UnusedNameProv
-> SrcSpan -> OccName -> IOEnv (Env TcGblEnv TcLclEnv) ()
warn_unused_name UnusedNameProv
prov (Name -> SrcSpan
nameSrcSpan Name
child) OccName
child_occ
warn_unused_name :: UnusedNameProv -> SrcSpan -> OccName -> RnM ()
warn_unused_name :: UnusedNameProv
-> SrcSpan -> OccName -> IOEnv (Env TcGblEnv TcLclEnv) ()
warn_unused_name UnusedNameProv
prov SrcSpan
span OccName
child_occ =
SrcSpan -> TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
addDiagnosticAt SrcSpan
span (OccName -> UnusedNameProv -> TcRnMessage
TcRnUnusedName OccName
child_occ UnusedNameProv
prov)
warnUnusedGRE :: GlobalRdrElt -> RnM ()
warnUnusedGRE :: GlobalRdrElt -> IOEnv (Env TcGblEnv TcLclEnv) ()
warnUnusedGRE gre :: GlobalRdrElt
gre@(GRE { gre_lcl :: forall info. GlobalRdrEltX info -> Bool
gre_lcl = Bool
lcl, gre_imp :: forall info. GlobalRdrEltX info -> Bag ImportSpec
gre_imp = Bag ImportSpec
is })
| Bool
lcl = UnusedNameProv
-> Name -> OccName -> IOEnv (Env TcGblEnv TcLclEnv) ()
warnUnused1 UnusedNameProv
UnusedNameTopDecl Name
nm OccName
occ
| Bool
otherwise = Bool
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Name -> OccName -> Bool
reportable Name
nm OccName
occ) ((ImportSpec -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> Bag ImportSpec -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ImportSpec -> IOEnv (Env TcGblEnv TcLclEnv) ()
warn Bag ImportSpec
is)
where
occ :: OccName
occ = GlobalRdrElt -> OccName
forall info. GlobalRdrEltX info -> OccName
greOccName GlobalRdrElt
gre
nm :: Name
nm = GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName GlobalRdrElt
gre
warn :: ImportSpec -> IOEnv (Env TcGblEnv TcLclEnv) ()
warn ImportSpec
spec =
UnusedNameProv
-> SrcSpan -> OccName -> IOEnv (Env TcGblEnv TcLclEnv) ()
warn_unused_name (ModuleName -> UnusedNameProv
UnusedNameImported (ImportSpec -> ModuleName
importSpecModule ImportSpec
spec)) SrcSpan
span OccName
occ
where
span :: SrcSpan
span = ImportSpec -> SrcSpan
importSpecLoc ImportSpec
spec
reportable :: Name -> OccName -> Bool
reportable :: Name -> OccName -> Bool
reportable Name
child OccName
child_occ
| Name -> Bool
isWiredInName Name
child
= Bool
False
| Bool
otherwise
= Bool -> Bool
not (OccName -> Bool
startsWithUnderscore OccName
child_occ)
addNameClashErrRn :: RdrName -> NE.NonEmpty GlobalRdrElt -> RnM ()
addNameClashErrRn :: RdrName
-> NonEmpty GlobalRdrElt -> IOEnv (Env TcGblEnv TcLclEnv) ()
addNameClashErrRn RdrName
rdr_name NonEmpty GlobalRdrElt
gres
| (GlobalRdrElt -> Bool) -> NonEmpty GlobalRdrElt -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all GlobalRdrElt -> Bool
forall info. GlobalRdrEltX info -> Bool
isLocalGRE NonEmpty GlobalRdrElt
gres Bool -> Bool -> Bool
&& Bool
can_skip
= () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise
= do { gre_env <- TcRn GlobalRdrEnv
getGlobalRdrEnv
; addErr $ mkNameClashErr gre_env rdr_name gres }
where
can_skip :: Bool
can_skip = Int
num_non_flds Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2
Bool -> Bool -> Bool
|| (Int
num_flds Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2 Bool -> Bool -> Bool
&& Bool -> Bool
not (GlobalRdrElt -> Bool
isDuplicateRecFldGRE ([GlobalRdrElt] -> GlobalRdrElt
forall a. HasCallStack => [a] -> a
head [GlobalRdrElt]
flds)))
Bool -> Bool -> Bool
|| (Int
num_non_flds Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1 Bool -> Bool -> Bool
&& Int
num_flds Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1
Bool -> Bool -> Bool
&& Bool -> Bool
not (GlobalRdrElt -> Bool
isNoFieldSelectorGRE ([GlobalRdrElt] -> GlobalRdrElt
forall a. HasCallStack => [a] -> a
head [GlobalRdrElt]
flds)))
([GlobalRdrElt]
flds, [GlobalRdrElt]
non_flds) = (GlobalRdrElt -> Bool)
-> NonEmpty GlobalRdrElt -> ([GlobalRdrElt], [GlobalRdrElt])
forall a. (a -> Bool) -> NonEmpty a -> ([a], [a])
NE.partition GlobalRdrElt -> Bool
forall info. GlobalRdrEltX info -> Bool
isRecFldGRE NonEmpty GlobalRdrElt
gres
num_flds :: Int
num_flds = [GlobalRdrElt] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [GlobalRdrElt]
flds
num_non_flds :: Int
num_non_flds = [GlobalRdrElt] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [GlobalRdrElt]
non_flds
mkNameClashErr :: GlobalRdrEnv -> RdrName -> NE.NonEmpty GlobalRdrElt -> TcRnMessage
mkNameClashErr :: GlobalRdrEnv -> RdrName -> NonEmpty GlobalRdrElt -> TcRnMessage
mkNameClashErr GlobalRdrEnv
gre_env RdrName
rdr_name NonEmpty GlobalRdrElt
gres = GlobalRdrEnv -> RdrName -> NonEmpty GlobalRdrElt -> TcRnMessage
TcRnAmbiguousName GlobalRdrEnv
gre_env RdrName
rdr_name NonEmpty GlobalRdrElt
gres
dupNamesErr :: NE.NonEmpty SrcSpan -> NE.NonEmpty RdrName -> RnM ()
dupNamesErr :: NonEmpty SrcSpan
-> NonEmpty RdrName -> IOEnv (Env TcGblEnv TcLclEnv) ()
dupNamesErr NonEmpty SrcSpan
locs NonEmpty RdrName
names
= SrcSpan -> TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErrAt SrcSpan
big_loc (RdrName -> NonEmpty SrcSpan -> TcRnMessage
TcRnBindingNameConflict (NonEmpty RdrName -> RdrName
forall a. NonEmpty a -> a
NE.head NonEmpty RdrName
names) NonEmpty SrcSpan
locs)
where
big_loc :: SrcSpan
big_loc = (SrcSpan -> SrcSpan -> SrcSpan) -> NonEmpty SrcSpan -> SrcSpan
forall a. (a -> a -> a) -> NonEmpty a -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 SrcSpan -> SrcSpan -> SrcSpan
combineSrcSpans NonEmpty SrcSpan
locs
badQualBndrErr :: RdrName -> TcRnMessage
badQualBndrErr :: RdrName -> TcRnMessage
badQualBndrErr RdrName
rdr_name = RdrName -> TcRnMessage
TcRnQualifiedBinder RdrName
rdr_name
typeAppErr :: TypeOrKind -> LHsType GhcPs -> TcRnMessage
typeAppErr :: TypeOrKind -> LHsType GhcPs -> TcRnMessage
typeAppErr TypeOrKind
what (L SrcSpanAnnA
_ HsType GhcPs
k) = TypeApplication -> TcRnMessage
TcRnTypeApplicationsDisabled (HsType GhcPs -> TypeOrKind -> TypeApplication
TypeApplication HsType GhcPs
k TypeOrKind
what)
badFieldConErr :: Name -> FieldLabelString -> TcRnMessage
badFieldConErr :: Name -> FieldLabelString -> TcRnMessage
badFieldConErr Name
con FieldLabelString
field = Name -> FieldLabelString -> TcRnMessage
TcRnInvalidRecordField Name
con FieldLabelString
field
checkTupSize :: Int -> TcM ()
checkTupSize :: Int -> IOEnv (Env TcGblEnv TcLclEnv) ()
checkTupSize Int
tup_size
| Int
tup_size Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
mAX_TUPLE_SIZE
= () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise
= TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErr (Int -> TcRnMessage
TcRnTupleTooLarge Int
tup_size)
checkCTupSize :: Int -> TcM ()
checkCTupSize :: Int -> IOEnv (Env TcGblEnv TcLclEnv) ()
checkCTupSize Int
tup_size
| Int
tup_size Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
mAX_CTUPLE_SIZE
= () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise
= TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErr (Int -> TcRnMessage
TcRnCTupleTooLarge Int
tup_size)
wrapGenSpan :: (HasAnnotation an) => a -> GenLocated an a
wrapGenSpan :: forall an a. HasAnnotation an => a -> GenLocated an a
wrapGenSpan a
x = an -> a -> GenLocated an a
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> an
forall e. HasAnnotation e => SrcSpan -> e
noAnnSrcSpan SrcSpan
generatedSrcSpan) a
x
mkRnSyntaxExpr :: Name -> SyntaxExprRn
mkRnSyntaxExpr :: Name -> SyntaxExprRn
mkRnSyntaxExpr = HsExpr GhcRn -> SyntaxExprRn
SyntaxExprRn (HsExpr GhcRn -> SyntaxExprRn)
-> (Name -> HsExpr GhcRn) -> Name -> SyntaxExprRn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> HsExpr GhcRn
genHsVar
genHsVar :: Name -> HsExpr GhcRn
genHsVar :: Name -> HsExpr GhcRn
genHsVar Name
n = XVar GhcRn -> LIdP GhcRn -> HsExpr GhcRn
forall p. XVar p -> LIdP p -> HsExpr p
HsVar XVar GhcRn
NoExtField
noExtField (Name -> GenLocated SrcSpanAnnN Name
forall an a. HasAnnotation an => a -> GenLocated an a
wrapGenSpan Name
n)
genHsApps :: Name -> [LHsExpr GhcRn] -> HsExpr GhcRn
genHsApps :: Name -> [LHsExpr GhcRn] -> HsExpr GhcRn
genHsApps Name
fun [LHsExpr GhcRn]
args = (HsExpr GhcRn
-> GenLocated SrcSpanAnnA (HsExpr GhcRn) -> HsExpr GhcRn)
-> HsExpr GhcRn
-> [GenLocated SrcSpanAnnA (HsExpr GhcRn)]
-> HsExpr GhcRn
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl HsExpr GhcRn -> LHsExpr GhcRn -> HsExpr GhcRn
HsExpr GhcRn
-> GenLocated SrcSpanAnnA (HsExpr GhcRn) -> HsExpr GhcRn
genHsApp (Name -> HsExpr GhcRn
genHsVar Name
fun) [LHsExpr GhcRn]
[GenLocated SrcSpanAnnA (HsExpr GhcRn)]
args
genHsApps' :: LocatedN Name -> [LHsExpr GhcRn] -> HsExpr GhcRn
genHsApps' :: GenLocated SrcSpanAnnN Name -> [LHsExpr GhcRn] -> HsExpr GhcRn
genHsApps' (L SrcSpanAnnN
_ Name
fun) [] = Name -> HsExpr GhcRn
genHsVar Name
fun
genHsApps' (L SrcSpanAnnN
loc Name
fun) (LHsExpr GhcRn
arg:[LHsExpr GhcRn]
args) = (HsExpr GhcRn
-> GenLocated SrcSpanAnnA (HsExpr GhcRn) -> HsExpr GhcRn)
-> HsExpr GhcRn
-> [GenLocated SrcSpanAnnA (HsExpr GhcRn)]
-> HsExpr GhcRn
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl HsExpr GhcRn -> LHsExpr GhcRn -> HsExpr GhcRn
HsExpr GhcRn
-> GenLocated SrcSpanAnnA (HsExpr GhcRn) -> HsExpr GhcRn
genHsApp (GenLocated SrcSpanAnnA (HsExpr GhcRn) -> HsExpr GhcRn
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpanAnnA (HsExpr GhcRn) -> HsExpr GhcRn)
-> GenLocated SrcSpanAnnA (HsExpr GhcRn) -> HsExpr GhcRn
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcRn -> LHsExpr GhcRn -> LHsExpr GhcRn
forall (id :: Pass).
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
mkHsApp (SrcSpanAnnA
-> HsExpr GhcRn -> GenLocated SrcSpanAnnA (HsExpr GhcRn)
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnN -> SrcSpanAnnA
forall a b. (HasLoc a, HasAnnotation b) => a -> b
l2l SrcSpanAnnN
loc) (HsExpr GhcRn -> GenLocated SrcSpanAnnA (HsExpr GhcRn))
-> HsExpr GhcRn -> GenLocated SrcSpanAnnA (HsExpr GhcRn)
forall a b. (a -> b) -> a -> b
$ Name -> HsExpr GhcRn
genHsVar Name
fun) LHsExpr GhcRn
arg) [LHsExpr GhcRn]
[GenLocated SrcSpanAnnA (HsExpr GhcRn)]
args
genHsExpApps :: HsExpr GhcRn -> [LHsExpr GhcRn] -> HsExpr GhcRn
genHsExpApps :: HsExpr GhcRn -> [LHsExpr GhcRn] -> HsExpr GhcRn
genHsExpApps HsExpr GhcRn
fun [LHsExpr GhcRn]
arg = (HsExpr GhcRn
-> GenLocated SrcSpanAnnA (HsExpr GhcRn) -> HsExpr GhcRn)
-> HsExpr GhcRn
-> [GenLocated SrcSpanAnnA (HsExpr GhcRn)]
-> HsExpr GhcRn
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl HsExpr GhcRn -> LHsExpr GhcRn -> HsExpr GhcRn
HsExpr GhcRn
-> GenLocated SrcSpanAnnA (HsExpr GhcRn) -> HsExpr GhcRn
genHsApp HsExpr GhcRn
fun [LHsExpr GhcRn]
[GenLocated SrcSpanAnnA (HsExpr GhcRn)]
arg
genHsApp :: HsExpr GhcRn -> LHsExpr GhcRn -> HsExpr GhcRn
genHsApp :: HsExpr GhcRn -> LHsExpr GhcRn -> HsExpr GhcRn
genHsApp HsExpr GhcRn
fun LHsExpr GhcRn
arg = XApp GhcRn -> LHsExpr GhcRn -> LHsExpr GhcRn -> HsExpr GhcRn
forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
HsApp XApp GhcRn
NoExtField
noExtField (HsExpr GhcRn -> GenLocated SrcSpanAnnA (HsExpr GhcRn)
forall an a. HasAnnotation an => a -> GenLocated an a
wrapGenSpan HsExpr GhcRn
fun) LHsExpr GhcRn
arg
genLHsApp :: HsExpr GhcRn -> LHsExpr GhcRn -> LHsExpr GhcRn
genLHsApp :: HsExpr GhcRn -> LHsExpr GhcRn -> LHsExpr GhcRn
genLHsApp HsExpr GhcRn
fun LHsExpr GhcRn
arg = HsExpr GhcRn -> GenLocated SrcSpanAnnA (HsExpr GhcRn)
forall an a. HasAnnotation an => a -> GenLocated an a
wrapGenSpan (HsExpr GhcRn -> LHsExpr GhcRn -> HsExpr GhcRn
genHsApp HsExpr GhcRn
fun LHsExpr GhcRn
arg)
genLHsVar :: Name -> LHsExpr GhcRn
genLHsVar :: Name -> LHsExpr GhcRn
genLHsVar Name
nm = HsExpr GhcRn -> GenLocated SrcSpanAnnA (HsExpr GhcRn)
forall an a. HasAnnotation an => a -> GenLocated an a
wrapGenSpan (HsExpr GhcRn -> GenLocated SrcSpanAnnA (HsExpr GhcRn))
-> HsExpr GhcRn -> GenLocated SrcSpanAnnA (HsExpr GhcRn)
forall a b. (a -> b) -> a -> b
$ Name -> HsExpr GhcRn
genHsVar Name
nm
genAppType :: HsExpr GhcRn -> HsType (NoGhcTc GhcRn) -> HsExpr GhcRn
genAppType :: HsExpr GhcRn -> HsType (NoGhcTc GhcRn) -> HsExpr GhcRn
genAppType HsExpr GhcRn
expr HsType (NoGhcTc GhcRn)
ty = XAppTypeE GhcRn
-> LHsExpr GhcRn -> LHsWcType (NoGhcTc GhcRn) -> HsExpr GhcRn
forall p.
XAppTypeE p -> LHsExpr p -> LHsWcType (NoGhcTc p) -> HsExpr p
HsAppType XAppTypeE GhcRn
NoExtField
noExtField (HsExpr GhcRn -> GenLocated SrcSpanAnnA (HsExpr GhcRn)
forall an a. HasAnnotation an => a -> GenLocated an a
wrapGenSpan HsExpr GhcRn
expr) (GenLocated SrcSpanAnnA (HsType GhcRn)
-> HsWildCardBndrs GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn))
forall thing. thing -> HsWildCardBndrs GhcRn thing
mkEmptyWildCardBndrs (HsType GhcRn -> GenLocated SrcSpanAnnA (HsType GhcRn)
forall an a. HasAnnotation an => a -> GenLocated an a
wrapGenSpan HsType (NoGhcTc GhcRn)
HsType GhcRn
ty))
genLHsLit :: (NoAnn an) => HsLit GhcRn -> LocatedAn an (HsExpr GhcRn)
genLHsLit :: forall an. NoAnn an => HsLit GhcRn -> LocatedAn an (HsExpr GhcRn)
genLHsLit = HsExpr GhcRn -> GenLocated (EpAnn an) (HsExpr GhcRn)
forall an a. HasAnnotation an => a -> GenLocated an a
wrapGenSpan (HsExpr GhcRn -> GenLocated (EpAnn an) (HsExpr GhcRn))
-> (HsLit GhcRn -> HsExpr GhcRn)
-> HsLit GhcRn
-> GenLocated (EpAnn an) (HsExpr GhcRn)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XLitE GhcRn -> HsLit GhcRn -> HsExpr GhcRn
forall p. XLitE p -> HsLit p -> HsExpr p
HsLit XLitE GhcRn
NoExtField
noExtField
genHsIntegralLit :: (NoAnn an) => IntegralLit -> LocatedAn an (HsExpr GhcRn)
genHsIntegralLit :: forall an. NoAnn an => IntegralLit -> LocatedAn an (HsExpr GhcRn)
genHsIntegralLit = HsLit GhcRn -> LocatedAn an (HsExpr GhcRn)
forall an. NoAnn an => HsLit GhcRn -> LocatedAn an (HsExpr GhcRn)
genLHsLit (HsLit GhcRn -> LocatedAn an (HsExpr GhcRn))
-> (IntegralLit -> HsLit GhcRn)
-> IntegralLit
-> LocatedAn an (HsExpr GhcRn)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XHsInt GhcRn -> IntegralLit -> HsLit GhcRn
forall x. XHsInt x -> IntegralLit -> HsLit x
HsInt XHsInt GhcRn
NoExtField
noExtField
genHsTyLit :: FastString -> HsType GhcRn
genHsTyLit :: FastString -> HsType GhcRn
genHsTyLit = XTyLit GhcRn -> HsTyLit GhcRn -> HsType GhcRn
forall pass. XTyLit pass -> HsTyLit pass -> HsType pass
HsTyLit XTyLit GhcRn
NoExtField
noExtField (HsTyLit GhcRn -> HsType GhcRn)
-> (FastString -> HsTyLit GhcRn) -> FastString -> HsType GhcRn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XStrTy GhcRn -> FastString -> HsTyLit GhcRn
forall pass. XStrTy pass -> FastString -> HsTyLit pass
HsStrTy XStrTy GhcRn
SourceText
NoSourceText
genSimpleConPat :: Name -> [LPat GhcRn] -> LPat GhcRn
genSimpleConPat :: Name -> [LPat GhcRn] -> LPat GhcRn
genSimpleConPat Name
con [LPat GhcRn]
pats
= Pat GhcRn -> GenLocated SrcSpanAnnA (Pat GhcRn)
forall an a. HasAnnotation an => a -> GenLocated an a
wrapGenSpan (Pat GhcRn -> GenLocated SrcSpanAnnA (Pat GhcRn))
-> Pat GhcRn -> GenLocated SrcSpanAnnA (Pat GhcRn)
forall a b. (a -> b) -> a -> b
$ ConPat { pat_con_ext :: XConPat GhcRn
pat_con_ext = XConPat GhcRn
NoExtField
noExtField
, pat_con :: XRec GhcRn (ConLikeP GhcRn)
pat_con = Name -> GenLocated SrcSpanAnnN Name
forall an a. HasAnnotation an => a -> GenLocated an a
wrapGenSpan Name
con
, pat_args :: HsConPatDetails GhcRn
pat_args = [HsConPatTyArg (NoGhcTc GhcRn)]
-> [LPat GhcRn] -> HsConPatDetails GhcRn
forall tyarg arg rec.
[tyarg] -> [arg] -> HsConDetails tyarg arg rec
PrefixCon [] [LPat GhcRn]
pats }
genVarPat :: Name -> LPat GhcRn
genVarPat :: Name -> LPat GhcRn
genVarPat Name
n = Pat GhcRn -> GenLocated SrcSpanAnnA (Pat GhcRn)
forall an a. HasAnnotation an => a -> GenLocated an a
wrapGenSpan (Pat GhcRn -> GenLocated SrcSpanAnnA (Pat GhcRn))
-> Pat GhcRn -> GenLocated SrcSpanAnnA (Pat GhcRn)
forall a b. (a -> b) -> a -> b
$ XVarPat GhcRn -> LIdP GhcRn -> Pat GhcRn
forall p. XVarPat p -> LIdP p -> Pat p
VarPat XVarPat GhcRn
NoExtField
noExtField (Name -> GenLocated SrcSpanAnnN Name
forall an a. HasAnnotation an => a -> GenLocated an a
wrapGenSpan Name
n)
genWildPat :: LPat GhcRn
genWildPat :: LPat GhcRn
genWildPat = Pat GhcRn -> GenLocated SrcSpanAnnA (Pat GhcRn)
forall an a. HasAnnotation an => a -> GenLocated an a
wrapGenSpan (Pat GhcRn -> GenLocated SrcSpanAnnA (Pat GhcRn))
-> Pat GhcRn -> GenLocated SrcSpanAnnA (Pat GhcRn)
forall a b. (a -> b) -> a -> b
$ XWildPat GhcRn -> Pat GhcRn
forall p. XWildPat p -> Pat p
WildPat XWildPat GhcRn
NoExtField
noExtField
genSimpleFunBind :: Name -> [LPat GhcRn]
-> LHsExpr GhcRn -> LHsBind GhcRn
genSimpleFunBind :: Name -> [LPat GhcRn] -> LHsExpr GhcRn -> LHsBind GhcRn
genSimpleFunBind Name
fun [LPat GhcRn]
pats LHsExpr GhcRn
expr
= HsBind GhcRn -> GenLocated SrcSpanAnnA (HsBind GhcRn)
forall an a. HasAnnotation an => a -> GenLocated an a
noLocA (HsBind GhcRn -> GenLocated SrcSpanAnnA (HsBind GhcRn))
-> HsBind GhcRn -> GenLocated SrcSpanAnnA (HsBind GhcRn)
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnN Name
-> [LMatch GhcRn (LHsExpr GhcRn)] -> HsBind GhcRn
genFunBind (Name -> GenLocated SrcSpanAnnN Name
forall an a. HasAnnotation an => a -> GenLocated an a
noLocA Name
fun)
[HsMatchContext (LIdP (NoGhcTc GhcRn))
-> LocatedE [LPat GhcRn]
-> LHsExpr GhcRn
-> HsLocalBinds GhcRn
-> LMatch GhcRn (LHsExpr GhcRn)
forall (p :: Pass).
IsPass p =>
HsMatchContext (LIdP (NoGhcTc (GhcPass p)))
-> LocatedE [LPat (GhcPass p)]
-> LHsExpr (GhcPass p)
-> HsLocalBinds (GhcPass p)
-> LMatch (GhcPass p) (LHsExpr (GhcPass p))
mkMatch (GenLocated SrcSpanAnnN Name
-> AnnFunRhs -> HsMatchContext (GenLocated SrcSpanAnnN Name)
forall fn. fn -> AnnFunRhs -> HsMatchContext fn
mkPrefixFunRhs (Name -> GenLocated SrcSpanAnnN Name
forall an a. HasAnnotation an => a -> GenLocated an a
noLocA Name
fun) AnnFunRhs
forall a. NoAnn a => a
noAnn) ([GenLocated SrcSpanAnnA (Pat GhcRn)]
-> GenLocated EpaLocation [GenLocated SrcSpanAnnA (Pat GhcRn)]
forall an a. HasAnnotation an => a -> GenLocated an a
noLocA [LPat GhcRn]
[GenLocated SrcSpanAnnA (Pat GhcRn)]
pats) LHsExpr GhcRn
expr
HsLocalBinds GhcRn
forall (a :: Pass) (b :: Pass).
HsLocalBindsLR (GhcPass a) (GhcPass b)
emptyLocalBinds]
genFunBind :: LocatedN Name -> [LMatch GhcRn (LHsExpr GhcRn)]
-> HsBind GhcRn
genFunBind :: GenLocated SrcSpanAnnN Name
-> [LMatch GhcRn (LHsExpr GhcRn)] -> HsBind GhcRn
genFunBind GenLocated SrcSpanAnnN Name
fn [LMatch GhcRn (LHsExpr GhcRn)]
ms
= FunBind { fun_id :: LIdP GhcRn
fun_id = LIdP GhcRn
GenLocated SrcSpanAnnN Name
fn
, fun_matches :: MatchGroup GhcRn (LHsExpr GhcRn)
fun_matches = Origin
-> LocatedLW
[LocatedA (Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
-> MatchGroup GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
forall (p :: Pass) (body :: * -> *).
AnnoBody p body =>
Origin
-> LocatedLW
[LocatedA (Match (GhcPass p) (LocatedA (body (GhcPass p))))]
-> MatchGroup (GhcPass p) (LocatedA (body (GhcPass p)))
mkMatchGroup (GenReason -> DoPmc -> Origin
Generated GenReason
OtherExpansion DoPmc
SkipPmc) ([LocatedA (Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
-> LocatedLW
[LocatedA (Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
forall an a. HasAnnotation an => a -> GenLocated an a
wrapGenSpan [LMatch GhcRn (LHsExpr GhcRn)]
[LocatedA (Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
ms)
, fun_ext :: XFunBind GhcRn GhcRn
fun_ext = XFunBind GhcRn GhcRn
FreeVars
emptyNameSet
}
genHsLet :: HsLocalBindsLR GhcRn GhcRn -> LHsExpr GhcRn -> HsExpr GhcRn
genHsLet :: HsLocalBinds GhcRn -> LHsExpr GhcRn -> HsExpr GhcRn
genHsLet HsLocalBinds GhcRn
bindings LHsExpr GhcRn
body = XLet GhcRn -> HsLocalBinds GhcRn -> LHsExpr GhcRn -> HsExpr GhcRn
forall p. XLet p -> HsLocalBinds p -> LHsExpr p -> HsExpr p
HsLet XLet GhcRn
NoExtField
noExtField HsLocalBinds GhcRn
bindings LHsExpr GhcRn
body
genHsLamDoExp :: (IsPass p, XMG (GhcPass p) (LHsExpr (GhcPass p)) ~ Origin)
=> HsDoFlavour
-> [LPat (GhcPass p)]
-> LHsExpr (GhcPass p)
-> LHsExpr (GhcPass p)
genHsLamDoExp :: forall (p :: Pass).
(IsPass p, XMG (GhcPass p) (LHsExpr (GhcPass p)) ~ Origin) =>
HsDoFlavour
-> [LPat (GhcPass p)] -> LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
genHsLamDoExp HsDoFlavour
doFlav [LPat (GhcPass p)]
pats LHsExpr (GhcPass p)
body = LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
forall (p :: Pass).
IsPass p =>
LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
mkHsPar (HsExpr (GhcPass p) -> LocatedA (HsExpr (GhcPass p))
forall an a. HasAnnotation an => a -> GenLocated an a
wrapGenSpan (HsExpr (GhcPass p) -> LocatedA (HsExpr (GhcPass p)))
-> HsExpr (GhcPass p) -> LocatedA (HsExpr (GhcPass p))
forall a b. (a -> b) -> a -> b
$ XLam (GhcPass p)
-> HsLamVariant
-> MatchGroup (GhcPass p) (LHsExpr (GhcPass p))
-> HsExpr (GhcPass p)
forall p.
XLam p -> HsLamVariant -> MatchGroup p (LHsExpr p) -> HsExpr p
HsLam XLam (GhcPass p)
EpAnnLam
forall a. NoAnn a => a
noAnn HsLamVariant
LamSingle MatchGroup (GhcPass p) (LHsExpr (GhcPass p))
MatchGroup (GhcPass p) (LocatedA (HsExpr (GhcPass p)))
matches)
where
matches :: MatchGroup (GhcPass p) (LocatedA (HsExpr (GhcPass p)))
matches = Origin
-> LocatedLW
[LocatedA (Match (GhcPass p) (LocatedA (HsExpr (GhcPass p))))]
-> MatchGroup (GhcPass p) (LocatedA (HsExpr (GhcPass p)))
forall (p :: Pass) (body :: * -> *).
AnnoBody p body =>
Origin
-> LocatedLW
[LocatedA (Match (GhcPass p) (LocatedA (body (GhcPass p))))]
-> MatchGroup (GhcPass p) (LocatedA (body (GhcPass p)))
mkMatchGroup (HsDoFlavour -> Origin
doExpansionOrigin HsDoFlavour
doFlav)
([LocatedA (Match (GhcPass p) (LocatedA (HsExpr (GhcPass p))))]
-> LocatedLW
[LocatedA (Match (GhcPass p) (LocatedA (HsExpr (GhcPass p))))]
forall an a. HasAnnotation an => a -> GenLocated an a
wrapGenSpan [HsMatchContext (LIdP (NoGhcTc (GhcPass p)))
-> [LPat (GhcPass p)]
-> LocatedA (HsExpr (GhcPass p))
-> LMatch (GhcPass p) (LocatedA (HsExpr (GhcPass p)))
forall (p :: Pass) (body :: * -> *).
(Anno (Match (GhcPass p) (LocatedA (body (GhcPass p))))
~ SrcSpanAnnA,
Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p)))) ~ EpAnnCO) =>
HsMatchContext (LIdP (NoGhcTc (GhcPass p)))
-> [LPat (GhcPass p)]
-> LocatedA (body (GhcPass p))
-> LMatch (GhcPass p) (LocatedA (body (GhcPass p)))
genSimpleMatch (HsStmtContext
(GenLocated
(Anno (IdGhcP (NoGhcTcPass p))) (IdGhcP (NoGhcTcPass p)))
-> HsMatchContext
(GenLocated
(Anno (IdGhcP (NoGhcTcPass p))) (IdGhcP (NoGhcTcPass p)))
forall fn. HsStmtContext fn -> HsMatchContext fn
StmtCtxt (HsDoFlavour
-> HsStmtContext
(GenLocated
(Anno (IdGhcP (NoGhcTcPass p))) (IdGhcP (NoGhcTcPass p)))
forall fn. HsDoFlavour -> HsStmtContext fn
HsDoStmt HsDoFlavour
doFlav)) [LPat (GhcPass p)]
[GenLocated SrcSpanAnnA (Pat (GhcPass p))]
pats' LHsExpr (GhcPass p)
LocatedA (HsExpr (GhcPass p))
body])
pats' :: [GenLocated SrcSpanAnnA (Pat (GhcPass p))]
pats' = (GenLocated SrcSpanAnnA (Pat (GhcPass p))
-> GenLocated SrcSpanAnnA (Pat (GhcPass p)))
-> [GenLocated SrcSpanAnnA (Pat (GhcPass p))]
-> [GenLocated SrcSpanAnnA (Pat (GhcPass p))]
forall a b. (a -> b) -> [a] -> [b]
map (PprPrec -> LPat (GhcPass p) -> LPat (GhcPass p)
forall (p :: Pass).
IsPass p =>
PprPrec -> LPat (GhcPass p) -> LPat (GhcPass p)
parenthesizePat PprPrec
appPrec) [LPat (GhcPass p)]
[GenLocated SrcSpanAnnA (Pat (GhcPass p))]
pats
genHsCaseAltDoExp :: (Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p))))
~ EpAnnCO,
Anno (Match (GhcPass p) (LocatedA (body (GhcPass p))))
~ SrcSpanAnnA)
=> HsDoFlavour -> LPat (GhcPass p) -> (LocatedA (body (GhcPass p)))
-> LMatch (GhcPass p) (LocatedA (body (GhcPass p)))
genHsCaseAltDoExp :: forall (p :: Pass) (body :: * -> *).
(Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p)))) ~ EpAnnCO,
Anno (Match (GhcPass p) (LocatedA (body (GhcPass p))))
~ SrcSpanAnnA) =>
HsDoFlavour
-> LPat (GhcPass p)
-> LocatedA (body (GhcPass p))
-> LMatch (GhcPass p) (LocatedA (body (GhcPass p)))
genHsCaseAltDoExp HsDoFlavour
doFlav LPat (GhcPass p)
pat LocatedA (body (GhcPass p))
expr
= HsMatchContext (LIdP (NoGhcTc (GhcPass p)))
-> [LPat (GhcPass p)]
-> LocatedA (body (GhcPass p))
-> LMatch (GhcPass p) (LocatedA (body (GhcPass p)))
forall (p :: Pass) (body :: * -> *).
(Anno (Match (GhcPass p) (LocatedA (body (GhcPass p))))
~ SrcSpanAnnA,
Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p)))) ~ EpAnnCO) =>
HsMatchContext (LIdP (NoGhcTc (GhcPass p)))
-> [LPat (GhcPass p)]
-> LocatedA (body (GhcPass p))
-> LMatch (GhcPass p) (LocatedA (body (GhcPass p)))
genSimpleMatch (HsStmtContext
(GenLocated
(Anno (IdGhcP (NoGhcTcPass p))) (IdGhcP (NoGhcTcPass p)))
-> HsMatchContext
(GenLocated
(Anno (IdGhcP (NoGhcTcPass p))) (IdGhcP (NoGhcTcPass p)))
forall fn. HsStmtContext fn -> HsMatchContext fn
StmtCtxt (HsDoFlavour
-> HsStmtContext
(GenLocated
(Anno (IdGhcP (NoGhcTcPass p))) (IdGhcP (NoGhcTcPass p)))
forall fn. HsDoFlavour -> HsStmtContext fn
HsDoStmt HsDoFlavour
doFlav)) [LPat (GhcPass p)
pat] LocatedA (body (GhcPass p))
expr
genSimpleMatch :: (Anno (Match (GhcPass p) (LocatedA (body (GhcPass p))))
~ SrcSpanAnnA,
Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p))))
~ EpAnnCO)
=> HsMatchContext (LIdP (NoGhcTc (GhcPass p)))
-> [LPat (GhcPass p)] -> LocatedA (body (GhcPass p))
-> LMatch (GhcPass p) (LocatedA (body (GhcPass p)))
genSimpleMatch :: forall (p :: Pass) (body :: * -> *).
(Anno (Match (GhcPass p) (LocatedA (body (GhcPass p))))
~ SrcSpanAnnA,
Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p)))) ~ EpAnnCO) =>
HsMatchContext (LIdP (NoGhcTc (GhcPass p)))
-> [LPat (GhcPass p)]
-> LocatedA (body (GhcPass p))
-> LMatch (GhcPass p) (LocatedA (body (GhcPass p)))
genSimpleMatch HsMatchContext (LIdP (NoGhcTc (GhcPass p)))
ctxt [LPat (GhcPass p)]
pats LocatedA (body (GhcPass p))
rhs
= Match (GhcPass p) (LocatedA (body (GhcPass p)))
-> GenLocated
SrcSpanAnnA (Match (GhcPass p) (LocatedA (body (GhcPass p))))
forall an a. HasAnnotation an => a -> GenLocated an a
wrapGenSpan (Match (GhcPass p) (LocatedA (body (GhcPass p)))
-> GenLocated
SrcSpanAnnA (Match (GhcPass p) (LocatedA (body (GhcPass p)))))
-> Match (GhcPass p) (LocatedA (body (GhcPass p)))
-> GenLocated
SrcSpanAnnA (Match (GhcPass p) (LocatedA (body (GhcPass p))))
forall a b. (a -> b) -> a -> b
$
Match { m_ext :: XCMatch (GhcPass p) (LocatedA (body (GhcPass p)))
m_ext = XCMatch (GhcPass p) (LocatedA (body (GhcPass p)))
NoExtField
noExtField, m_ctxt :: HsMatchContext (LIdP (NoGhcTc (GhcPass p)))
m_ctxt = HsMatchContext (LIdP (NoGhcTc (GhcPass p)))
ctxt, m_pats :: XRec (GhcPass p) [LPat (GhcPass p)]
m_pats = [GenLocated SrcSpanAnnA (Pat (GhcPass p))]
-> GenLocated
EpaLocation [GenLocated SrcSpanAnnA (Pat (GhcPass p))]
forall an a. HasAnnotation an => a -> GenLocated an a
noLocA [LPat (GhcPass p)]
[GenLocated SrcSpanAnnA (Pat (GhcPass p))]
pats
, m_grhss :: GRHSs (GhcPass p) (LocatedA (body (GhcPass p)))
m_grhss = SrcSpan
-> LocatedA (body (GhcPass p))
-> EpAnn GrhsAnn
-> GRHSs (GhcPass p) (LocatedA (body (GhcPass p)))
forall (p :: Pass) (body :: * -> *).
(Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p))))
~ EpAnnCO) =>
SrcSpan
-> LocatedA (body (GhcPass p))
-> EpAnn GrhsAnn
-> GRHSs (GhcPass p) (LocatedA (body (GhcPass p)))
unguardedGRHSs SrcSpan
generatedSrcSpan LocatedA (body (GhcPass p))
rhs EpAnn GrhsAnn
forall a. NoAnn a => a
noAnn }