{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE GADTs #-}
module GHC.Rename.Utils (
checkDupRdrNames, checkDupRdrNamesN, checkShadowedRdrNames,
checkDupNames, checkDupAndShadowedNames, dupNamesErr,
checkTupSize, checkCTupSize,
addFvRn, mapFvRn, mapMaybeFvRn,
warnUnusedMatches, warnUnusedTypePatterns,
warnUnusedTopBinds, warnUnusedLocalBinds,
warnForallIdentifier,
checkUnusedRecordWildcard,
mkFieldEnv,
badQualBndrErr, typeAppErr, badFieldConErr,
wrapGenSpan, genHsVar, genLHsVar, genHsApp, genHsApps, genAppType,
genHsIntegralLit, genHsTyLit, genSimpleConPat,
genVarPat, genWildPat,
genSimpleFunBind, genFunBind,
newLocalBndrRn, newLocalBndrsRn,
bindLocalNames, bindLocalNamesFV,
addNameClashErrRn,
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.Env
import GHC.Tc.Utils.Monad
import GHC.Types.Error
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.Panic
import GHC.Utils.Misc
import GHC.Types.Basic ( TopLevelFlag(..), Origin(Generated) )
import GHC.Data.List.SetOps ( removeDups )
import GHC.Data.Maybe ( whenIsJust )
import GHC.Driver.Session
import GHC.Data.FastString
import Control.Monad
import Data.List (find, sortBy)
import GHC.Settings.Constants ( mAX_TUPLE_SIZE, mAX_CTUPLE_SIZE )
import qualified Data.List.NonEmpty as NE
import qualified GHC.LanguageExtensions as LangExt
import GHC.Data.Bag
import qualified Data.List as List
newLocalBndrRn :: LocatedN RdrName -> RnM Name
newLocalBndrRn :: GenLocated (SrcSpanAnn' (EpAnn NameAnn)) RdrName -> RnM Name
newLocalBndrRn (L SrcSpanAnn' (EpAnn NameAnn)
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 (SrcSpanAnn' (EpAnn NameAnn) -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnn' (EpAnn NameAnn)
loc) (RdrName -> TcRnMessage
badQualBndrErr RdrName
rdr_name))
; Unique
uniq <- TcRnIf TcGblEnv TcLclEnv Unique
forall gbl lcl. TcRnIf gbl lcl Unique
newUnique
; Name -> RnM Name
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Unique -> OccName -> SrcSpan -> Name
mkInternalName Unique
uniq (RdrName -> OccName
rdrNameOcc RdrName
rdr_name) (SrcSpanAnn' (EpAnn NameAnn) -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnn' (EpAnn NameAnn)
loc)) }
newLocalBndrsRn :: [LocatedN RdrName] -> RnM [Name]
newLocalBndrsRn :: [GenLocated (SrcSpanAnn' (EpAnn NameAnn)) RdrName] -> RnM [Name]
newLocalBndrsRn = (GenLocated (SrcSpanAnn' (EpAnn NameAnn)) RdrName -> RnM Name)
-> [GenLocated (SrcSpanAnn' (EpAnn NameAnn)) 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 GenLocated (SrcSpanAnn' (EpAnn NameAnn)) RdrName -> RnM Name
newLocalBndrRn
bindLocalNames :: [Name] -> RnM a -> RnM a
bindLocalNames :: forall a. [Name] -> RnM a -> RnM a
bindLocalNames [Name]
names
= (TcLclEnv -> TcLclEnv)
-> TcRnIf TcGblEnv TcLclEnv a -> TcRnIf TcGblEnv TcLclEnv a
forall lcl gbl a.
(lcl -> lcl) -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
updLclEnv ((TcLclEnv -> TcLclEnv)
-> TcRnIf TcGblEnv TcLclEnv a -> TcRnIf TcGblEnv TcLclEnv a)
-> (TcLclEnv -> TcLclEnv)
-> TcRnIf TcGblEnv TcLclEnv a
-> TcRnIf TcGblEnv TcLclEnv a
forall a b. (a -> b) -> a -> b
$ \ TcLclEnv
lcl_env ->
let th_level :: Int
th_level = ThStage -> Int
thLevel (TcLclEnv -> ThStage
tcl_th_ctxt TcLclEnv
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 (TcLclEnv -> NameEnv (TopLevelFlag, Int)
tcl_th_bndrs TcLclEnv
lcl_env)
[ (Name
n, (TopLevelFlag
NotTopLevel, Int
th_level)) | Name
n <- [Name]
names ]
rdr_env' :: LocalRdrEnv
rdr_env' = LocalRdrEnv -> [Name] -> LocalRdrEnv
extendLocalRdrEnvList (TcLclEnv -> LocalRdrEnv
tcl_rdr TcLclEnv
lcl_env) [Name]
names
in TcLclEnv
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 { (a
result, FreeVars
fvs) <- [Name] -> RnM (a, FreeVars) -> RnM (a, FreeVars)
forall a. [Name] -> RnM a -> RnM a
bindLocalNames [Name]
names RnM (a, FreeVars)
enclosed_scope
; (a, FreeVars) -> RnM (a, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
result, [Name] -> FreeVars -> FreeVars
delFVs [Name]
names FreeVars
fvs) }
checkDupRdrNames :: [LocatedN RdrName] -> RnM ()
checkDupRdrNames :: [GenLocated (SrcSpanAnn' (EpAnn NameAnn)) RdrName]
-> IOEnv (Env TcGblEnv TcLclEnv) ()
checkDupRdrNames [GenLocated (SrcSpanAnn' (EpAnn NameAnn)) RdrName]
rdr_names_w_loc
= (NonEmpty (GenLocated (SrcSpanAnn' (EpAnn NameAnn)) RdrName)
-> IOEnv (Env TcGblEnv TcLclEnv) ())
-> [NonEmpty (GenLocated (SrcSpanAnn' (EpAnn NameAnn)) RdrName)]
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((GenLocated (SrcSpanAnn' (EpAnn NameAnn)) RdrName -> SrcSpan)
-> NonEmpty (GenLocated (SrcSpanAnn' (EpAnn NameAnn)) RdrName)
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall n.
Outputable n =>
(n -> SrcSpan) -> NonEmpty n -> IOEnv (Env TcGblEnv TcLclEnv) ()
dupNamesErr GenLocated (SrcSpanAnn' (EpAnn NameAnn)) RdrName -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA) [NonEmpty (GenLocated (SrcSpanAnn' (EpAnn NameAnn)) RdrName)]
dups
where
([GenLocated (SrcSpanAnn' (EpAnn NameAnn)) RdrName]
_, [NonEmpty (GenLocated (SrcSpanAnn' (EpAnn NameAnn)) RdrName)]
dups) = (GenLocated (SrcSpanAnn' (EpAnn NameAnn)) RdrName
-> GenLocated (SrcSpanAnn' (EpAnn NameAnn)) RdrName -> Ordering)
-> [GenLocated (SrcSpanAnn' (EpAnn NameAnn)) RdrName]
-> ([GenLocated (SrcSpanAnn' (EpAnn NameAnn)) RdrName],
[NonEmpty (GenLocated (SrcSpanAnn' (EpAnn NameAnn)) RdrName)])
forall a. (a -> a -> Ordering) -> [a] -> ([a], [NonEmpty a])
removeDups (\GenLocated (SrcSpanAnn' (EpAnn NameAnn)) RdrName
n1 GenLocated (SrcSpanAnn' (EpAnn NameAnn)) RdrName
n2 -> GenLocated (SrcSpanAnn' (EpAnn NameAnn)) RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc GenLocated (SrcSpanAnn' (EpAnn NameAnn)) RdrName
n1 RdrName -> RdrName -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` GenLocated (SrcSpanAnn' (EpAnn NameAnn)) RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc GenLocated (SrcSpanAnn' (EpAnn NameAnn)) RdrName
n2) [GenLocated (SrcSpanAnn' (EpAnn NameAnn)) RdrName]
rdr_names_w_loc
checkDupRdrNamesN :: [LocatedN RdrName] -> RnM ()
checkDupRdrNamesN :: [GenLocated (SrcSpanAnn' (EpAnn NameAnn)) RdrName]
-> IOEnv (Env TcGblEnv TcLclEnv) ()
checkDupRdrNamesN [GenLocated (SrcSpanAnn' (EpAnn NameAnn)) RdrName]
rdr_names_w_loc
= (NonEmpty (GenLocated (SrcSpanAnn' (EpAnn NameAnn)) RdrName)
-> IOEnv (Env TcGblEnv TcLclEnv) ())
-> [NonEmpty (GenLocated (SrcSpanAnn' (EpAnn NameAnn)) RdrName)]
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((GenLocated (SrcSpanAnn' (EpAnn NameAnn)) RdrName -> SrcSpan)
-> NonEmpty (GenLocated (SrcSpanAnn' (EpAnn NameAnn)) RdrName)
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall n.
Outputable n =>
(n -> SrcSpan) -> NonEmpty n -> IOEnv (Env TcGblEnv TcLclEnv) ()
dupNamesErr GenLocated (SrcSpanAnn' (EpAnn NameAnn)) RdrName -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA) [NonEmpty (GenLocated (SrcSpanAnn' (EpAnn NameAnn)) RdrName)]
dups
where
([GenLocated (SrcSpanAnn' (EpAnn NameAnn)) RdrName]
_, [NonEmpty (GenLocated (SrcSpanAnn' (EpAnn NameAnn)) RdrName)]
dups) = (GenLocated (SrcSpanAnn' (EpAnn NameAnn)) RdrName
-> GenLocated (SrcSpanAnn' (EpAnn NameAnn)) RdrName -> Ordering)
-> [GenLocated (SrcSpanAnn' (EpAnn NameAnn)) RdrName]
-> ([GenLocated (SrcSpanAnn' (EpAnn NameAnn)) RdrName],
[NonEmpty (GenLocated (SrcSpanAnn' (EpAnn NameAnn)) RdrName)])
forall a. (a -> a -> Ordering) -> [a] -> ([a], [NonEmpty a])
removeDups (\GenLocated (SrcSpanAnn' (EpAnn NameAnn)) RdrName
n1 GenLocated (SrcSpanAnn' (EpAnn NameAnn)) RdrName
n2 -> GenLocated (SrcSpanAnn' (EpAnn NameAnn)) RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc GenLocated (SrcSpanAnn' (EpAnn NameAnn)) RdrName
n1 RdrName -> RdrName -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` GenLocated (SrcSpanAnn' (EpAnn NameAnn)) RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc GenLocated (SrcSpanAnn' (EpAnn NameAnn)) RdrName
n2) [GenLocated (SrcSpanAnn' (EpAnn NameAnn)) 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_ ((Name -> SrcSpan)
-> NonEmpty Name -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall n.
Outputable n =>
(n -> SrcSpan) -> NonEmpty n -> IOEnv (Env TcGblEnv TcLclEnv) ()
dupNamesErr Name -> SrcSpan
nameSrcSpan) [NonEmpty Name]
dups
where
([Name]
_, [NonEmpty Name]
dups) = (Name -> Name -> Ordering) -> [Name] -> ([Name], [NonEmpty Name])
forall a. (a -> a -> Ordering) -> [a] -> ([a], [NonEmpty a])
removeDups (\Name
n1 Name
n2 -> Name -> OccName
nameOccName Name
n1 OccName -> OccName -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Name -> OccName
nameOccName Name
n2) [Name]
names
checkShadowedRdrNames :: [LocatedN RdrName] -> RnM ()
checkShadowedRdrNames :: [GenLocated (SrcSpanAnn' (EpAnn NameAnn)) RdrName]
-> IOEnv (Env TcGblEnv TcLclEnv) ()
checkShadowedRdrNames [GenLocated (SrcSpanAnn' (EpAnn NameAnn)) RdrName]
loc_rdr_names
= do { (GlobalRdrEnv, LocalRdrEnv)
envs <- TcRn (GlobalRdrEnv, LocalRdrEnv)
getRdrEnvs
; (GlobalRdrEnv, LocalRdrEnv)
-> (GenLocated (SrcSpanAnn' (EpAnn NameAnn)) RdrName
-> (SrcSpan, OccName))
-> [GenLocated (SrcSpanAnn' (EpAnn NameAnn)) RdrName]
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a.
(GlobalRdrEnv, LocalRdrEnv)
-> (a -> (SrcSpan, OccName))
-> [a]
-> IOEnv (Env TcGblEnv TcLclEnv) ()
checkShadowedOccs (GlobalRdrEnv, LocalRdrEnv)
envs GenLocated (SrcSpanAnn' (EpAnn NameAnn)) RdrName
-> (SrcSpan, OccName)
forall {a}.
GenLocated (SrcSpanAnn' a) RdrName -> (SrcSpan, OccName)
get_loc_occ [GenLocated (SrcSpanAnn' (EpAnn NameAnn)) RdrName]
filtered_rdrs }
where
filtered_rdrs :: [GenLocated (SrcSpanAnn' (EpAnn NameAnn)) RdrName]
filtered_rdrs = (GenLocated (SrcSpanAnn' (EpAnn NameAnn)) RdrName -> Bool)
-> [GenLocated (SrcSpanAnn' (EpAnn NameAnn)) RdrName]
-> [GenLocated (SrcSpanAnn' (EpAnn NameAnn)) RdrName]
forall a. (a -> Bool) -> [a] -> [a]
filterOut (RdrName -> Bool
isExact (RdrName -> Bool)
-> (GenLocated (SrcSpanAnn' (EpAnn NameAnn)) RdrName -> RdrName)
-> GenLocated (SrcSpanAnn' (EpAnn NameAnn)) RdrName
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated (SrcSpanAnn' (EpAnn NameAnn)) RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc) [GenLocated (SrcSpanAnn' (EpAnn NameAnn)) RdrName]
loc_rdr_names
get_loc_occ :: GenLocated (SrcSpanAnn' a) RdrName -> (SrcSpan, OccName)
get_loc_occ (L SrcSpanAnn' a
loc RdrName
rdr) = (SrcSpanAnn' a -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnn' 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 { [GlobalRdrElt]
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
; Bool
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool)
-> ([GlobalRdrElt] -> Bool) -> [GlobalRdrElt] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [GlobalRdrElt] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([GlobalRdrElt] -> Bool) -> [GlobalRdrElt] -> Bool
forall a b. (a -> b) -> a -> b
$ [GlobalRdrElt]
gres') (IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ ShadowedNameProvenance -> IOEnv (Env TcGblEnv TcLclEnv) ()
complain ([GlobalRdrElt] -> ShadowedNameProvenance
ShadowedNameProvenanceGlobal [GlobalRdrElt]
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 = RdrName -> GlobalRdrEnv -> [GlobalRdrElt]
lookupGRE_RdrName (OccName -> RdrName
mkRdrUnqual OccName
occ) GlobalRdrEnv
global_env
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
isRecFldGRE GlobalRdrElt
gre
= do { DynFlags
dflags <- IOEnv (Env TcGblEnv TcLclEnv) DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
; Bool -> IOEnv (Env TcGblEnv TcLclEnv) Bool
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IOEnv (Env TcGblEnv TcLclEnv) Bool)
-> Bool -> IOEnv (Env TcGblEnv TcLclEnv) Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Extension -> DynFlags -> Bool
xopt Extension
LangExt.NamedFieldPuns DynFlags
dflags
Bool -> Bool -> Bool
|| Extension -> DynFlags -> Bool
xopt Extension
LangExt.RecordWildCards DynFlags
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
-> Maybe SDoc
-> LHsSigType GhcPs
-> RnM ()
checkInferredVars :: HsDocContext
-> Maybe SDoc
-> LHsSigType GhcPs
-> IOEnv (Env TcGblEnv TcLclEnv) ()
checkInferredVars HsDocContext
_ Maybe SDoc
Nothing LHsSigType GhcPs
_ = () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
checkInferredVars HsDocContext
ctxt (Just SDoc
msg) 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]
-> Maybe (HsTyVarBndr Specificity GhcPs)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (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
Maybe (HsTyVarBndr Specificity GhcPs)
Nothing -> () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just HsTyVarBndr Specificity GhcPs
_ -> 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
$
DiagnosticMessage -> TcRnMessage
forall a.
(Diagnostic a, Typeable a, DiagnosticOpts a ~ NoDiagnosticOpts) =>
a -> TcRnMessage
mkTcRnUnknownMessage (DiagnosticMessage -> TcRnMessage)
-> DiagnosticMessage -> TcRnMessage
forall a b. (a -> b) -> a -> b
$ [GhcHint] -> SDoc -> DiagnosticMessage
mkPlainError [GhcHint]
noHints SDoc
msg
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 :: SDoc -> LHsType GhcRn -> Maybe (SrcSpan, TcRnMessage)
noNestedForallsContextsErr :: SDoc -> LHsType GhcRn -> Maybe (SrcSpan, TcRnMessage)
noNestedForallsContextsErr SDoc
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. SrcSpanAnn' 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. SrcSpanAnn' 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. SrcSpanAnn' 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 =
DiagnosticMessage -> TcRnMessage
forall a.
(Diagnostic a, Typeable a, DiagnosticOpts a ~ NoDiagnosticOpts) =>
a -> TcRnMessage
mkTcRnUnknownMessage (DiagnosticMessage -> TcRnMessage)
-> DiagnosticMessage -> TcRnMessage
forall a b. (a -> b) -> a -> b
$ [GhcHint] -> SDoc -> DiagnosticMessage
mkPlainError [GhcHint]
noHints (SDoc -> DiagnosticMessage) -> SDoc -> DiagnosticMessage
forall a b. (a -> b) -> a -> b
$
SDoc
what SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"cannot contain nested"
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes SDoc
forAllLit SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"s or contexts"
addNoNestedForallsContextsErr :: HsDocContext -> SDoc -> LHsType GhcRn -> RnM ()
addNoNestedForallsContextsErr :: HsDocContext
-> SDoc -> LHsType GhcRn -> IOEnv (Env TcGblEnv TcLclEnv) ()
addNoNestedForallsContextsErr HsDocContext
ctxt SDoc
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 (SDoc -> LHsType GhcRn -> Maybe (SrcSpan, TcRnMessage)
noNestedForallsContextsErr SDoc
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 { (thing
res, FreeVars
fvs2) <- RnM (thing, FreeVars)
thing_inside
; (thing, FreeVars) -> RnM (thing, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (thing
res, FreeVars
fvs1 FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
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
f (b, FreeVars)
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 f (b, FreeVars) -> (f b, f FreeVars)
forall (f :: * -> *) a b. Functor f => f (a, b) -> (f a, f b)
unzip f (b, FreeVars)
stuff of
(f b
ys, f FreeVars
fvs_s) -> (f b, FreeVars) -> RnM (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 { (b
y, FreeVars
fvs) <- a -> RnM (b, FreeVars)
f a
x; (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 (b -> Maybe b
forall a. a -> Maybe a
Just b
y, FreeVars
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 TcGblEnv
env <- TcRnIf TcGblEnv TcLclEnv TcGblEnv
forall gbl lcl. TcRnIf gbl lcl gbl
getGblEnv
let isBoot :: Bool
isBoot = TcGblEnv -> HscSource
tcg_src TcGblEnv
env HscSource -> HscSource -> Bool
forall a. Eq a => a -> a -> Bool
== HscSource
HsBootFile
let noParent :: GlobalRdrElt -> Bool
noParent GlobalRdrElt
gre = case GlobalRdrElt -> Parent
gre_par GlobalRdrElt
gre of
Parent
NoParent -> Bool
True
Parent
_ -> Bool
False
gres' :: [GlobalRdrElt]
gres' = if Bool
isBoot then (GlobalRdrElt -> Bool) -> [GlobalRdrElt] -> [GlobalRdrElt]
forall a. (a -> Bool) -> [a] -> [a]
filter GlobalRdrElt -> Bool
noParent [GlobalRdrElt]
gres
else [GlobalRdrElt]
gres
[GlobalRdrElt] -> IOEnv (Env TcGblEnv TcLclEnv) ()
warnUnusedGREs [GlobalRdrElt]
gres'
checkUnusedRecordWildcard :: SrcSpan
-> FreeVars
-> Maybe [Name]
-> RnM ()
checkUnusedRecordWildcard :: SrcSpan
-> FreeVars -> Maybe [Name] -> IOEnv (Env TcGblEnv TcLclEnv) ()
checkUnusedRecordWildcard SrcSpan
_ FreeVars
_ Maybe [Name]
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
_ (Just []) =
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
$ IOEnv (Env TcGblEnv TcLclEnv) ()
warnRedundantRecordWildcard
checkUnusedRecordWildcard SrcSpan
loc FreeVars
fvs (Just [Name]
dotdot_names) =
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
$ [Name] -> FreeVars -> IOEnv (Env TcGblEnv TcLclEnv) ()
warnUnusedRecordWildcard [Name]
dotdot_names FreeVars
fvs
warnRedundantRecordWildcard :: RnM ()
warnRedundantRecordWildcard :: IOEnv (Env TcGblEnv TcLclEnv) ()
warnRedundantRecordWildcard =
WarningFlag
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall gbl lcl.
WarningFlag -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
whenWOptM WarningFlag
Opt_WarnRedundantRecordWildcards (IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$
let msg :: TcRnMessage
msg = DiagnosticMessage -> TcRnMessage
forall a.
(Diagnostic a, Typeable a, DiagnosticOpts a ~ NoDiagnosticOpts) =>
a -> TcRnMessage
mkTcRnUnknownMessage (DiagnosticMessage -> TcRnMessage)
-> DiagnosticMessage -> TcRnMessage
forall a b. (a -> b) -> a -> b
$
DiagnosticReason -> [GhcHint] -> SDoc -> DiagnosticMessage
mkPlainDiagnostic (WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnRedundantRecordWildcards)
[GhcHint]
noHints
SDoc
redundantWildcardWarning
in TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
addDiagnostic TcRnMessage
msg
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)
TcRnMessage
unusedRecordWildcardWarning
warnUnusedLocalBinds, warnUnusedMatches, warnUnusedTypePatterns
:: [Name] -> FreeVars -> RnM ()
warnUnusedLocalBinds :: [Name] -> FreeVars -> IOEnv (Env TcGblEnv TcLclEnv) ()
warnUnusedLocalBinds = WarningFlag
-> [Name] -> FreeVars -> IOEnv (Env TcGblEnv TcLclEnv) ()
check_unused WarningFlag
Opt_WarnUnusedLocalBinds
warnUnusedMatches :: [Name] -> FreeVars -> IOEnv (Env TcGblEnv TcLclEnv) ()
warnUnusedMatches = WarningFlag
-> [Name] -> FreeVars -> IOEnv (Env TcGblEnv TcLclEnv) ()
check_unused WarningFlag
Opt_WarnUnusedMatches
warnUnusedTypePatterns :: [Name] -> FreeVars -> IOEnv (Env TcGblEnv TcLclEnv) ()
warnUnusedTypePatterns = WarningFlag
-> [Name] -> FreeVars -> IOEnv (Env TcGblEnv TcLclEnv) ()
check_unused WarningFlag
Opt_WarnUnusedTypePatterns
check_unused :: WarningFlag -> [Name] -> FreeVars -> RnM ()
check_unused :: WarningFlag
-> [Name] -> FreeVars -> IOEnv (Env TcGblEnv TcLclEnv) ()
check_unused WarningFlag
flag [Name]
bound_names FreeVars
used_names
= WarningFlag
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall gbl lcl.
WarningFlag -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
whenWOptM WarningFlag
flag (WarningFlag -> [Name] -> IOEnv (Env TcGblEnv TcLclEnv) ()
warnUnused WarningFlag
flag ((Name -> Bool) -> [Name] -> [Name]
forall a. (a -> Bool) -> [a] -> [a]
filterOut (Name -> FreeVars -> Bool
`elemNameSet` FreeVars
used_names)
[Name]
bound_names))
warnForallIdentifier :: LocatedN RdrName -> RnM ()
warnForallIdentifier :: GenLocated (SrcSpanAnn' (EpAnn NameAnn)) RdrName
-> IOEnv (Env TcGblEnv TcLclEnv) ()
warnForallIdentifier (L SrcSpanAnn' (EpAnn NameAnn)
l rdr_name :: RdrName
rdr_name@(Unqual OccName
occ))
| FastString -> Bool
isKw (String -> FastString
fsLit String
"forall") Bool -> Bool -> Bool
|| FastString -> Bool
isKw (String -> FastString
fsLit String
"∀")
= SrcSpan -> TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
addDiagnosticAt (SrcSpanAnn' (EpAnn NameAnn) -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnn' (EpAnn NameAnn)
l) (RdrName -> TcRnMessage
TcRnForallIdentifier RdrName
rdr_name)
where isKw :: FastString -> Bool
isKw = (OccName -> FastString
occNameFS OccName
occ FastString -> FastString -> Bool
forall a. Eq a => a -> a -> Bool
==)
warnForallIdentifier GenLocated (SrcSpanAnn' (EpAnn NameAnn)) RdrName
_ = () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
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 :: WarningFlag -> [Name] -> RnM ()
warnUnused :: WarningFlag -> [Name] -> IOEnv (Env TcGblEnv TcLclEnv) ()
warnUnused WarningFlag
flag [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_ (WarningFlag -> GreName -> IOEnv (Env TcGblEnv TcLclEnv) ()
warnUnused1 WarningFlag
flag (GreName -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> (Name -> GreName) -> Name -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> GreName
NormalGreName) [Name]
names
warnUnused1 :: WarningFlag -> GreName -> RnM ()
warnUnused1 :: WarningFlag -> GreName -> IOEnv (Env TcGblEnv TcLclEnv) ()
warnUnused1 WarningFlag
flag GreName
child
= Bool
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (GreName -> Bool
reportable GreName
child) (IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$
WarningFlag
-> OccName -> SrcSpan -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
addUnusedWarning WarningFlag
flag
(GreName -> OccName
forall name. HasOccName name => name -> OccName
occName GreName
child) (GreName -> SrcSpan
greNameSrcSpan GreName
child)
(String -> SDoc
forall doc. IsLine doc => String -> doc
text (String -> SDoc) -> String -> SDoc
forall a b. (a -> b) -> a -> b
$ String
"Defined but not used" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
opt_str)
where
opt_str :: String
opt_str = case WarningFlag
flag of
WarningFlag
Opt_WarnUnusedTypePatterns -> String
" on the right hand side"
WarningFlag
_ -> String
""
warnUnusedGRE :: GlobalRdrElt -> RnM ()
warnUnusedGRE :: GlobalRdrElt -> IOEnv (Env TcGblEnv TcLclEnv) ()
warnUnusedGRE gre :: GlobalRdrElt
gre@(GRE { gre_lcl :: GlobalRdrElt -> Bool
gre_lcl = Bool
lcl, gre_imp :: GlobalRdrElt -> Bag ImportSpec
gre_imp = Bag ImportSpec
is })
| Bool
lcl = WarningFlag -> GreName -> IOEnv (Env TcGblEnv TcLclEnv) ()
warnUnused1 WarningFlag
Opt_WarnUnusedTopBinds (GlobalRdrElt -> GreName
gre_name GlobalRdrElt
gre)
| Bool
otherwise = Bool
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (GreName -> Bool
reportable (GlobalRdrElt -> GreName
gre_name GlobalRdrElt
gre)) ((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
greOccName GlobalRdrElt
gre
warn :: ImportSpec -> IOEnv (Env TcGblEnv TcLclEnv) ()
warn ImportSpec
spec = WarningFlag
-> OccName -> SrcSpan -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
addUnusedWarning WarningFlag
Opt_WarnUnusedTopBinds OccName
occ SrcSpan
span SDoc
msg
where
span :: SrcSpan
span = ImportSpec -> SrcSpan
importSpecLoc ImportSpec
spec
pp_mod :: SDoc
pp_mod = SDoc -> SDoc
quotes (ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr (ImportSpec -> ModuleName
importSpecModule ImportSpec
spec))
msg :: SDoc
msg = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Imported from" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
pp_mod SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"but not used"
mkFieldEnv :: GlobalRdrEnv -> NameEnv (FieldLabelString, Parent)
mkFieldEnv :: GlobalRdrEnv -> NameEnv (FieldLabelString, Parent)
mkFieldEnv GlobalRdrEnv
rdr_env = [(Name, (FieldLabelString, Parent))]
-> NameEnv (FieldLabelString, Parent)
forall a. [(Name, a)] -> NameEnv a
mkNameEnv [ (GlobalRdrElt -> Name
greMangledName GlobalRdrElt
gre, (FieldLabel -> FieldLabelString
flLabel FieldLabel
fl, GlobalRdrElt -> Parent
gre_par GlobalRdrElt
gre))
| [GlobalRdrElt]
gres <- GlobalRdrEnv -> [[GlobalRdrElt]]
forall a. OccEnv a -> [a]
nonDetOccEnvElts GlobalRdrEnv
rdr_env
, GlobalRdrElt
gre <- [GlobalRdrElt]
gres
, Just FieldLabel
fl <- [GlobalRdrElt -> Maybe FieldLabel
greFieldLabel GlobalRdrElt
gre]
]
reportable :: GreName -> Bool
reportable :: GreName -> Bool
reportable GreName
child
| NormalGreName Name
name <- GreName
child
, Name -> Bool
isWiredInName Name
name = Bool
False
| Bool
otherwise = Bool -> Bool
not (OccName -> Bool
startsWithUnderscore (GreName -> OccName
forall name. HasOccName name => name -> OccName
occName GreName
child))
addUnusedWarning :: WarningFlag -> OccName -> SrcSpan -> SDoc -> RnM ()
addUnusedWarning :: WarningFlag
-> OccName -> SrcSpan -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
addUnusedWarning WarningFlag
flag OccName
occ SrcSpan
span SDoc
msg = do
let diag :: TcRnMessage
diag = DiagnosticMessage -> TcRnMessage
forall a.
(Diagnostic a, Typeable a, DiagnosticOpts a ~ NoDiagnosticOpts) =>
a -> TcRnMessage
mkTcRnUnknownMessage (DiagnosticMessage -> TcRnMessage)
-> DiagnosticMessage -> TcRnMessage
forall a b. (a -> b) -> a -> b
$ DiagnosticReason -> [GhcHint] -> SDoc -> DiagnosticMessage
mkPlainDiagnostic (WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
flag) [GhcHint]
noHints (SDoc -> DiagnosticMessage) -> SDoc -> DiagnosticMessage
forall a b. (a -> b) -> a -> b
$
[SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [SDoc
msg SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
colon,
Int -> SDoc -> SDoc
nest Int
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ NameSpace -> SDoc
pprNonVarNameSpace (OccName -> NameSpace
occNameSpace OccName
occ)
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr OccName
occ)]
SrcSpan -> TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
addDiagnosticAt SrcSpan
span TcRnMessage
diag
unusedRecordWildcardWarning :: TcRnMessage
unusedRecordWildcardWarning :: TcRnMessage
unusedRecordWildcardWarning =
DiagnosticMessage -> TcRnMessage
forall a.
(Diagnostic a, Typeable a, DiagnosticOpts a ~ NoDiagnosticOpts) =>
a -> TcRnMessage
mkTcRnUnknownMessage (DiagnosticMessage -> TcRnMessage)
-> DiagnosticMessage -> TcRnMessage
forall a b. (a -> b) -> a -> b
$ DiagnosticReason -> [GhcHint] -> SDoc -> DiagnosticMessage
mkPlainDiagnostic (WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnUnusedRecordWildcards) [GhcHint]
noHints (SDoc -> DiagnosticMessage) -> SDoc -> DiagnosticMessage
forall a b. (a -> b) -> a -> b
$
SDoc -> SDoc
wildcardDoc (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"No variables bound in the record wildcard match are used"
redundantWildcardWarning :: SDoc
redundantWildcardWarning :: SDoc
redundantWildcardWarning =
SDoc -> SDoc
wildcardDoc (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Record wildcard does not bind any new variables"
wildcardDoc :: SDoc -> SDoc
wildcardDoc :: SDoc -> SDoc
wildcardDoc SDoc
herald =
SDoc
herald
SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Int -> SDoc -> SDoc
nest Int
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Possible fix" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
colon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"omit the"
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
".."))
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
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
= TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErr (TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ DiagnosticMessage -> TcRnMessage
forall a.
(Diagnostic a, Typeable a, DiagnosticOpts a ~ NoDiagnosticOpts) =>
a -> TcRnMessage
mkTcRnUnknownMessage (DiagnosticMessage -> TcRnMessage)
-> DiagnosticMessage -> TcRnMessage
forall a b. (a -> b) -> a -> b
$ [GhcHint] -> SDoc -> DiagnosticMessage
mkPlainError [GhcHint]
noHints (SDoc -> DiagnosticMessage) -> SDoc -> DiagnosticMessage
forall a b. (a -> b) -> a -> b
$
([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Ambiguous occurrence" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
rdr_name)
, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"It could refer to"
, Int -> SDoc -> SDoc
nest Int
3 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat (SDoc
msg1 SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
: [SDoc]
msgs)) ])
where
GlobalRdrElt
np1 NE.:| [GlobalRdrElt]
nps = NonEmpty GlobalRdrElt
gres
msg1 :: SDoc
msg1 = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"either" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> GlobalRdrElt -> SDoc
ppr_gre GlobalRdrElt
np1
msgs :: [SDoc]
msgs = [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
" or" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> GlobalRdrElt -> SDoc
ppr_gre GlobalRdrElt
np | GlobalRdrElt
np <- [GlobalRdrElt]
nps]
ppr_gre :: GlobalRdrElt -> SDoc
ppr_gre GlobalRdrElt
gre = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ GlobalRdrElt -> SDoc
pp_greMangledName GlobalRdrElt
gre SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma
, GlobalRdrElt -> SDoc
pprNameProvenance GlobalRdrElt
gre]
pp_greMangledName :: GlobalRdrElt -> SDoc
pp_greMangledName gre :: GlobalRdrElt
gre@(GRE { gre_name :: GlobalRdrElt -> GreName
gre_name = GreName
child, gre_par :: GlobalRdrElt -> Parent
gre_par = Parent
par
, gre_lcl :: GlobalRdrElt -> Bool
gre_lcl = Bool
lcl, gre_imp :: GlobalRdrElt -> Bag ImportSpec
gre_imp = Bag ImportSpec
iss }) =
case GreName
child of
FieldGreName FieldLabel
fl -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the field" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (FieldLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr FieldLabel
fl) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
parent_info
NormalGreName Name
name -> SDoc -> SDoc
quotes (Name -> SDoc
pp_qual Name
name SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
dot SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Name -> OccName
nameOccName Name
name))
where
parent_info :: SDoc
parent_info = case Parent
par of
Parent
NoParent -> SDoc
forall doc. IsOutput doc => doc
empty
ParentIs { par_is :: Parent -> Name
par_is = Name
par_name } -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"of record" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
par_name)
pp_qual :: Name -> SDoc
pp_qual Name
name
| Bool
lcl
= Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr ((() :: Constraint) => Name -> Module
Name -> Module
nameModule Name
name)
| Just ImportSpec
imp <- Bag ImportSpec -> Maybe ImportSpec
forall a. Bag a -> Maybe a
headMaybe Bag ImportSpec
iss
, ImpDeclSpec { is_as :: ImpDeclSpec -> ModuleName
is_as = ModuleName
mod } <- ImportSpec -> ImpDeclSpec
is_decl ImportSpec
imp
= ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
mod
| Bool
otherwise
= String -> SDoc -> SDoc
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"addNameClassErrRn" (GlobalRdrElt -> SDoc
forall a. Outputable a => a -> SDoc
ppr GlobalRdrElt
gre SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Bag ImportSpec -> SDoc
forall a. Outputable a => a -> SDoc
ppr Bag ImportSpec
iss)
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
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
dupNamesErr :: Outputable n => (n -> SrcSpan) -> NE.NonEmpty n -> RnM ()
dupNamesErr :: forall n.
Outputable n =>
(n -> SrcSpan) -> NonEmpty n -> IOEnv (Env TcGblEnv TcLclEnv) ()
dupNamesErr n -> SrcSpan
get_loc NonEmpty n
names
= SrcSpan -> TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErrAt SrcSpan
big_loc (TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ DiagnosticMessage -> TcRnMessage
forall a.
(Diagnostic a, Typeable a, DiagnosticOpts a ~ NoDiagnosticOpts) =>
a -> TcRnMessage
mkTcRnUnknownMessage (DiagnosticMessage -> TcRnMessage)
-> DiagnosticMessage -> TcRnMessage
forall a b. (a -> b) -> a -> b
$ [GhcHint] -> SDoc -> DiagnosticMessage
mkPlainError [GhcHint]
noHints (SDoc -> DiagnosticMessage) -> SDoc -> DiagnosticMessage
forall a b. (a -> b) -> a -> b
$
[SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Conflicting definitions for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (n -> SDoc
forall a. Outputable a => a -> SDoc
ppr (NonEmpty n -> n
forall a. NonEmpty a -> a
NE.head NonEmpty n
names)),
SDoc
locations]
where
locs :: [SrcSpan]
locs = (n -> SrcSpan) -> [n] -> [SrcSpan]
forall a b. (a -> b) -> [a] -> [b]
map n -> SrcSpan
get_loc (NonEmpty n -> [n]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty n
names)
big_loc :: SrcSpan
big_loc = (SrcSpan -> SrcSpan -> SrcSpan) -> [SrcSpan] -> SrcSpan
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 SrcSpan -> SrcSpan -> SrcSpan
combineSrcSpans [SrcSpan]
locs
locations :: SDoc
locations = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Bound at:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((SrcSpan -> SDoc) -> [SrcSpan] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map SrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr ((SrcSpan -> SrcSpan -> Ordering) -> [SrcSpan] -> [SrcSpan]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy SrcSpan -> SrcSpan -> Ordering
SrcLoc.leftmost_smallest [SrcSpan]
locs))
badQualBndrErr :: RdrName -> TcRnMessage
badQualBndrErr :: RdrName -> TcRnMessage
badQualBndrErr RdrName
rdr_name
= DiagnosticMessage -> TcRnMessage
forall a.
(Diagnostic a, Typeable a, DiagnosticOpts a ~ NoDiagnosticOpts) =>
a -> TcRnMessage
mkTcRnUnknownMessage (DiagnosticMessage -> TcRnMessage)
-> DiagnosticMessage -> TcRnMessage
forall a b. (a -> b) -> a -> b
$ [GhcHint] -> SDoc -> DiagnosticMessage
mkPlainError [GhcHint]
noHints (SDoc -> DiagnosticMessage) -> SDoc -> DiagnosticMessage
forall a b. (a -> b) -> a -> b
$
String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Qualified name in binding position:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
rdr_name
typeAppErr :: String -> LHsType GhcPs -> TcRnMessage
typeAppErr :: String -> LHsType GhcPs -> TcRnMessage
typeAppErr String
what (L SrcSpanAnnA
_ HsType GhcPs
k)
= DiagnosticMessage -> TcRnMessage
forall a.
(Diagnostic a, Typeable a, DiagnosticOpts a ~ NoDiagnosticOpts) =>
a -> TcRnMessage
mkTcRnUnknownMessage (DiagnosticMessage -> TcRnMessage)
-> DiagnosticMessage -> TcRnMessage
forall a b. (a -> b) -> a -> b
$ [GhcHint] -> SDoc -> DiagnosticMessage
mkPlainError [GhcHint]
noHints (SDoc -> DiagnosticMessage) -> SDoc -> DiagnosticMessage
forall a b. (a -> b) -> a -> b
$
SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal visible" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
what SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"application"
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'@' SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> HsType GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsType GhcPs
k))
Int
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Perhaps you intended to use TypeApplications")
badFieldConErr :: Name -> FieldLabelString -> TcRnMessage
badFieldConErr :: Name -> FieldLabelString -> TcRnMessage
badFieldConErr Name
con FieldLabelString
field
= DiagnosticMessage -> TcRnMessage
forall a.
(Diagnostic a, Typeable a, DiagnosticOpts a ~ NoDiagnosticOpts) =>
a -> TcRnMessage
mkTcRnUnknownMessage (DiagnosticMessage -> TcRnMessage)
-> DiagnosticMessage -> TcRnMessage
forall a b. (a -> b) -> a -> b
$ [GhcHint] -> SDoc -> DiagnosticMessage
mkPlainError [GhcHint]
noHints (SDoc -> DiagnosticMessage) -> SDoc -> DiagnosticMessage
forall a b. (a -> b) -> a -> b
$
[SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Constructor" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
con),
String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"does not have field", SDoc -> SDoc
quotes (FieldLabelString -> SDoc
forall a. Outputable a => a -> SDoc
ppr 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 (TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ DiagnosticMessage -> TcRnMessage
forall a.
(Diagnostic a, Typeable a, DiagnosticOpts a ~ NoDiagnosticOpts) =>
a -> TcRnMessage
mkTcRnUnknownMessage (DiagnosticMessage -> TcRnMessage)
-> DiagnosticMessage -> TcRnMessage
forall a b. (a -> b) -> a -> b
$ [GhcHint] -> SDoc -> DiagnosticMessage
mkPlainError [GhcHint]
noHints (SDoc -> DiagnosticMessage) -> SDoc -> DiagnosticMessage
forall a b. (a -> b) -> a -> b
$
[SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"A" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Int -> SDoc
forall doc. IsLine doc => Int -> doc
int Int
tup_size SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"-tuple is too large for GHC",
Int -> SDoc -> SDoc
nest Int
2 (SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"max size is" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Int -> SDoc
forall doc. IsLine doc => Int -> doc
int Int
mAX_TUPLE_SIZE)),
Int -> SDoc -> SDoc
nest Int
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Workaround: use nested tuples or define a data type")]
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 (TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ DiagnosticMessage -> TcRnMessage
forall a.
(Diagnostic a, Typeable a, DiagnosticOpts a ~ NoDiagnosticOpts) =>
a -> TcRnMessage
mkTcRnUnknownMessage (DiagnosticMessage -> TcRnMessage)
-> DiagnosticMessage -> TcRnMessage
forall a b. (a -> b) -> a -> b
$ [GhcHint] -> SDoc -> DiagnosticMessage
mkPlainError [GhcHint]
noHints (SDoc -> DiagnosticMessage) -> SDoc -> DiagnosticMessage
forall a b. (a -> b) -> a -> b
$
SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Constraint tuple arity too large:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Int -> SDoc
forall doc. IsLine doc => Int -> doc
int Int
tup_size
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"max arity =" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Int -> SDoc
forall doc. IsLine doc => Int -> doc
int Int
mAX_CTUPLE_SIZE))
Int
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Instead, use a nested tuple")
wrapGenSpan :: a -> LocatedAn an a
wrapGenSpan :: forall a an. a -> LocatedAn an a
wrapGenSpan a
x = SrcAnn an -> a -> GenLocated (SrcAnn an) a
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcAnn an
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
generatedSrcSpan) a
x
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
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
EpAnn NoEpAnns
forall a. EpAnn a
noAnn (HsExpr GhcRn -> GenLocated SrcSpanAnnA (HsExpr GhcRn)
forall a an. a -> LocatedAn an a
wrapGenSpan HsExpr GhcRn
fun) LHsExpr GhcRn
arg
genLHsVar :: Name -> LHsExpr GhcRn
genLHsVar :: Name -> LHsExpr GhcRn
genLHsVar Name
nm = HsExpr GhcRn -> GenLocated SrcSpanAnnA (HsExpr GhcRn)
forall a an. a -> LocatedAn 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
genHsVar :: Name -> HsExpr GhcRn
genHsVar :: Name -> HsExpr GhcRn
genHsVar Name
nm = XVar GhcRn -> XRec GhcRn (IdP GhcRn) -> HsExpr GhcRn
forall p. XVar p -> LIdP p -> HsExpr p
HsVar XVar GhcRn
NoExtField
noExtField (XRec GhcRn (IdP GhcRn) -> HsExpr GhcRn)
-> XRec GhcRn (IdP GhcRn) -> HsExpr GhcRn
forall a b. (a -> b) -> a -> b
$ Name -> LocatedAn NameAnn Name
forall a an. a -> LocatedAn an a
wrapGenSpan 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
-> LHsToken "@" GhcRn
-> LHsWcType (NoGhcTc GhcRn)
-> HsExpr GhcRn
forall p.
XAppTypeE p
-> LHsExpr p -> LHsToken "@" p -> LHsWcType (NoGhcTc p) -> HsExpr p
HsAppType XAppTypeE GhcRn
NoExtField
noExtField (HsExpr GhcRn -> GenLocated SrcSpanAnnA (HsExpr GhcRn)
forall a an. a -> LocatedAn an a
wrapGenSpan HsExpr GhcRn
expr) LHsToken "@" GhcRn
GenLocated TokenLocation (HsToken "@")
forall (tok :: Symbol). GenLocated TokenLocation (HsToken tok)
noHsTok (GenLocated SrcSpanAnnA (HsType GhcRn)
-> HsWildCardBndrs GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn))
forall thing. thing -> HsWildCardBndrs GhcRn thing
mkEmptyWildCardBndrs (HsType GhcRn -> GenLocated SrcSpanAnnA (HsType GhcRn)
forall a an. a -> LocatedAn an a
wrapGenSpan HsType (NoGhcTc GhcRn)
HsType GhcRn
ty))
genHsIntegralLit :: IntegralLit -> LocatedAn an (HsExpr GhcRn)
genHsIntegralLit :: forall an. IntegralLit -> LocatedAn an (HsExpr GhcRn)
genHsIntegralLit IntegralLit
lit = HsExpr GhcRn -> LocatedAn an (HsExpr GhcRn)
forall a an. a -> LocatedAn an a
wrapGenSpan (HsExpr GhcRn -> LocatedAn an (HsExpr GhcRn))
-> HsExpr GhcRn -> LocatedAn an (HsExpr GhcRn)
forall a b. (a -> b) -> a -> b
$ XLitE GhcRn -> HsLit GhcRn -> HsExpr GhcRn
forall p. XLitE p -> HsLit p -> HsExpr p
HsLit XLitE GhcRn
EpAnn NoEpAnns
forall a. EpAnn a
noAnn (XHsInt GhcRn -> IntegralLit -> HsLit GhcRn
forall x. XHsInt x -> IntegralLit -> HsLit x
HsInt XHsInt GhcRn
NoExtField
noExtField IntegralLit
lit)
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 -> LocatedAn AnnListItem (Pat GhcRn)
forall a an. a -> LocatedAn an a
wrapGenSpan (Pat GhcRn -> LocatedAn AnnListItem (Pat GhcRn))
-> Pat GhcRn -> LocatedAn AnnListItem (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 -> LocatedAn NameAnn Name
forall a an. a -> LocatedAn an a
wrapGenSpan Name
con
, pat_args :: HsConPatDetails GhcRn
pat_args = [HsConPatTyArg GhcRn]
-> [LocatedAn AnnListItem (Pat GhcRn)]
-> HsConDetails
(HsConPatTyArg GhcRn)
(LocatedAn AnnListItem (Pat GhcRn))
(HsRecFields GhcRn (LocatedAn AnnListItem (Pat GhcRn)))
forall tyarg arg rec.
[tyarg] -> [arg] -> HsConDetails tyarg arg rec
PrefixCon [] [LPat GhcRn]
[LocatedAn AnnListItem (Pat GhcRn)]
pats }
genVarPat :: Name -> LPat GhcRn
genVarPat :: Name -> LPat GhcRn
genVarPat Name
n = Pat GhcRn -> LocatedAn AnnListItem (Pat GhcRn)
forall a an. a -> LocatedAn an a
wrapGenSpan (Pat GhcRn -> LocatedAn AnnListItem (Pat GhcRn))
-> Pat GhcRn -> LocatedAn AnnListItem (Pat GhcRn)
forall a b. (a -> b) -> a -> b
$ XVarPat GhcRn -> XRec GhcRn (IdP GhcRn) -> Pat GhcRn
forall p. XVarPat p -> LIdP p -> Pat p
VarPat XVarPat GhcRn
NoExtField
noExtField (Name -> LocatedAn NameAnn Name
forall a an. a -> LocatedAn an a
wrapGenSpan Name
n)
genWildPat :: LPat GhcRn
genWildPat :: LPat GhcRn
genWildPat = Pat GhcRn -> LocatedAn AnnListItem (Pat GhcRn)
forall a an. a -> LocatedAn an a
wrapGenSpan (Pat GhcRn -> LocatedAn AnnListItem (Pat GhcRn))
-> Pat GhcRn -> LocatedAn AnnListItem (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
= SrcSpanAnnA
-> HsBind GhcRn -> GenLocated SrcSpanAnnA (HsBind GhcRn)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
forall {ann}. SrcAnn ann
gen (HsBind GhcRn -> GenLocated SrcSpanAnnA (HsBind GhcRn))
-> HsBind GhcRn -> GenLocated SrcSpanAnnA (HsBind GhcRn)
forall a b. (a -> b) -> a -> b
$ LocatedAn NameAnn Name
-> [LMatch GhcRn (LHsExpr GhcRn)] -> HsBind GhcRn
genFunBind (SrcSpanAnn' (EpAnn NameAnn) -> Name -> LocatedAn NameAnn Name
forall l e. l -> e -> GenLocated l e
L SrcSpanAnn' (EpAnn NameAnn)
forall {ann}. SrcAnn ann
gen Name
fun)
[HsMatchContext GhcRn
-> [LPat GhcRn]
-> LHsExpr GhcRn
-> HsLocalBinds GhcRn
-> LMatch GhcRn (LHsExpr GhcRn)
forall (p :: Pass).
IsPass p =>
HsMatchContext (GhcPass p)
-> [LPat (GhcPass p)]
-> LHsExpr (GhcPass p)
-> HsLocalBinds (GhcPass p)
-> LMatch (GhcPass p) (LHsExpr (GhcPass p))
mkMatch (LIdP (NoGhcTc GhcRn) -> HsMatchContext GhcRn
forall p. LIdP (NoGhcTc p) -> HsMatchContext p
mkPrefixFunRhs (SrcSpanAnn' (EpAnn NameAnn) -> Name -> LocatedAn NameAnn Name
forall l e. l -> e -> GenLocated l e
L SrcSpanAnn' (EpAnn NameAnn)
forall {ann}. SrcAnn ann
gen Name
fun)) [LPat GhcRn]
pats LHsExpr GhcRn
expr
HsLocalBinds GhcRn
forall (a :: Pass) (b :: Pass).
HsLocalBindsLR (GhcPass a) (GhcPass b)
emptyLocalBinds]
where
gen :: SrcAnn ann
gen = SrcSpan -> SrcAnn ann
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
generatedSrcSpan
genFunBind :: LocatedN Name -> [LMatch GhcRn (LHsExpr GhcRn)]
-> HsBind GhcRn
genFunBind :: LocatedAn NameAnn Name
-> [LMatch GhcRn (LHsExpr GhcRn)] -> HsBind GhcRn
genFunBind LocatedAn NameAnn Name
fn [LMatch GhcRn (LHsExpr GhcRn)]
ms
= FunBind { fun_id :: XRec GhcRn (IdP GhcRn)
fun_id = XRec GhcRn (IdP GhcRn)
LocatedAn NameAnn Name
fn
, fun_matches :: MatchGroup GhcRn (LHsExpr GhcRn)
fun_matches = Origin
-> LocatedL
[LocatedA (Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
-> MatchGroup GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
forall (p :: Pass) (body :: * -> *).
AnnoBody p body =>
Origin
-> LocatedL
[LocatedA (Match (GhcPass p) (LocatedA (body (GhcPass p))))]
-> MatchGroup (GhcPass p) (LocatedA (body (GhcPass p)))
mkMatchGroup Origin
Generated ([LocatedA (Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
-> LocatedL
[LocatedA (Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
forall a an. a -> LocatedAn 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
}