{-
This module contains miscellaneous functions related to renaming.
-}{-# LANGUAGE FlexibleContexts #-}{-# LANGUAGE ViewPatterns #-}{-# LANGUAGE TypeFamilies #-}moduleRnUtils(checkDupRdrNames ,checkShadowedRdrNames ,checkDupNames ,checkDupAndShadowedNames ,dupNamesErr ,checkTupSize ,addFvRn ,mapFvRn ,mapMaybeFvRn ,warnUnusedMatches ,warnUnusedTypePatterns ,warnUnusedTopBinds ,warnUnusedLocalBinds ,mkFieldEnv ,unknownSubordinateErr ,badQualBndrErr ,typeAppErr ,HsDocContext (..),pprHsDocContext ,inHsDocContext ,withHsDocContext ,newLocalBndrRn ,newLocalBndrsRn ,bindLocalNames ,bindLocalNamesFV ,addNameClashErrRn ,extendTyVarEnvFVRn )whereimportGhcPrelude importHsSyn importRdrName importHscTypes importTcEnv importTcRnMonad importName importNameSet importNameEnv importDataCon importSrcLoc importOutputable importUtil importBasicTypes (TopLevelFlag (..))importListSetOps (removeDups )importDynFlags importFastString importControl.MonadimportData.ListimportConstants (mAX_TUPLE_SIZE )importqualifiedData.List.NonEmptyasNEimportqualifiedGHC.LanguageExtensions asLangExt{-
*********************************************************
* *
\subsection{Binding}
* *
*********************************************************
-}newLocalBndrRn::Located RdrName ->RnM Name -- Used for non-top-level binders. These should-- never be qualified.newLocalBndrRn (dL ->L loc rdr_name )|Justname <-isExact_maybe rdr_name =returnname -- This happens in code generated by Template Haskell-- See Note [Binders in Template Haskell] in Convert.hs|otherwise=do{unless(isUnqual rdr_name )(addErrAt loc (badQualBndrErr rdr_name ));uniq <-newUnique ;return(mkInternalName uniq (rdrNameOcc rdr_name )loc )}newLocalBndrsRn::[Located RdrName ]->RnM [Name ]newLocalBndrsRn =mapMnewLocalBndrRn bindLocalNames::[Name ]->RnM a ->RnM a bindLocalNames names enclosed_scope =do{lcl_env <-getLclEnv ;letth_level =thLevel (tcl_th_ctxtlcl_env )th_bndrs' =extendNameEnvList (tcl_th_bndrslcl_env )[(n ,(NotTopLevel ,th_level ))|n <-names ]rdr_env' =extendLocalRdrEnvList (tcl_rdrlcl_env )names ;setLclEnv (lcl_env {tcl_th_bndrs=th_bndrs' ,tcl_rdr=rdr_env' })enclosed_scope }bindLocalNamesFV::[Name ]->RnM (a ,FreeVars )->RnM (a ,FreeVars )bindLocalNamesFV names enclosed_scope =do{(result ,fvs )<-bindLocalNames names enclosed_scope ;return(result ,delFVs names fvs )}-------------------------------------extendTyVarEnvFVRn::[Name ]->RnM (a ,FreeVars )->RnM (a ,FreeVars )extendTyVarEnvFVRn tyvars thing_inside =bindLocalNamesFV tyvars thing_inside -------------------------------------checkDupRdrNames::[Located RdrName ]->RnM ()-- Check for duplicated names in a binding groupcheckDupRdrNames rdr_names_w_loc =mapM_(dupNamesErr getLoc )dups where(_,dups )=removeDups (\n1 n2 ->unLoc n1 `compare`unLoc n2 )rdr_names_w_loc checkDupNames::[Name ]->RnM ()-- Check for duplicated names in a binding groupcheckDupNames names =check_dup_names (filterOut isSystemName names )-- See Note [Binders in Template Haskell] in Convertcheck_dup_names::[Name ]->RnM ()check_dup_names names =mapM_(dupNamesErr nameSrcSpan )dups where(_,dups )=removeDups (\n1 n2 ->nameOccName n1 `compare`nameOccName n2 )names ---------------------checkShadowedRdrNames::[Located RdrName ]->RnM ()checkShadowedRdrNames loc_rdr_names =do{envs <-getRdrEnvs ;checkShadowedOccs envs get_loc_occ filtered_rdrs }wherefiltered_rdrs =filterOut (isExact .unLoc )loc_rdr_names -- See Note [Binders in Template Haskell] in Convertget_loc_occ (dL ->L loc rdr )=(loc ,rdrNameOcc rdr )checkDupAndShadowedNames::(GlobalRdrEnv ,LocalRdrEnv )->[Name ]->RnM ()checkDupAndShadowedNames envs names =do{check_dup_names filtered_names ;checkShadowedOccs envs get_loc_occ filtered_names }wherefiltered_names =filterOut isSystemName names -- See Note [Binders in Template Haskell] in Convertget_loc_occ name =(nameSrcSpan name ,nameOccName name )-------------------------------------checkShadowedOccs::(GlobalRdrEnv ,LocalRdrEnv )->(a ->(SrcSpan ,OccName ))->[a ]->RnM ()checkShadowedOccs (global_env ,local_env )get_loc_occ ns =whenWOptM Opt_WarnNameShadowing $do{traceRn "checkShadowedOccs:shadow"(ppr (mapget_loc_occ ns ));mapM_check_shadow ns }wherecheck_shadow n |startsWithUnderscore occ =return()-- Do not report shadowing for "_x"-- See Trac #3262|Justn <-mb_local =complain [text "bound at"<+> ppr (nameSrcLoc n )]|otherwise=do{gres' <-filterMis_shadowed_gre gres ;complain (mappprNameProvenance gres' )}where(loc ,occ )=get_loc_occ n mb_local =lookupLocalRdrOcc local_env occ gres =lookupGRE_RdrName (mkRdrUnqual occ )global_env -- Make an Unqualified RdrName and look that up, so that-- we don't find any GREs that are in scope qualified-onlycomplain []=return()complainpp_locs =addWarnAt (Reason Opt_WarnNameShadowing )loc (shadowedNameWarn occ pp_locs )is_shadowed_gre::GlobalRdrElt ->RnM Bool-- Returns False for record selectors that are shadowed, when-- punning or wild-cards are on (cf Trac #2723)is_shadowed_gre gre |isRecFldGRE gre =do{dflags <-getDynFlags ;return$not(xopt LangExt.RecordPuns dflags ||xopt LangExt.RecordWildCards dflags )}is_shadowed_gre_other =returnTrue{-
************************************************************************
* *
\subsection{Free variable manipulation}
* *
************************************************************************
-}-- A useful utilityaddFvRn::FreeVars ->RnM (thing ,FreeVars )->RnM (thing ,FreeVars )addFvRn fvs1 thing_inside =do{(res ,fvs2 )<-thing_inside ;return(res ,fvs1 `plusFV `fvs2 )}mapFvRn::(a ->RnM (b ,FreeVars ))->[a ]->RnM ([b ],FreeVars )mapFvRn f xs =dostuff <-mapMf xs caseunzipstuff of(ys ,fvs_s )->return(ys ,plusFVs fvs_s )mapMaybeFvRn::(a ->RnM (b ,FreeVars ))->Maybea ->RnM (Maybeb ,FreeVars )mapMaybeFvRn _Nothing=return(Nothing,emptyFVs )mapMaybeFvRnf (Justx )=do{(y ,fvs )<-f x ;return(Justy ,fvs )}{-
************************************************************************
* *
\subsection{Envt utility functions}
* *
************************************************************************
-}warnUnusedTopBinds::[GlobalRdrElt ]->RnM ()warnUnusedTopBinds gres =whenWOptM Opt_WarnUnusedTopBinds $doenv <-getGblEnv letisBoot =tcg_srcenv ==HsBootFile letnoParent gre =casegre_pargre ofNoParent ->True_->False-- Don't warn about unused bindings with parents in-- .hs-boot files, as you are sometimes required to give-- unused bindings (trac #3449).-- HOWEVER, in a signature file, you are never obligated to put a-- definition in the main text. Thus, if you define something-- and forget to export it, we really DO want to warn.gres' =ifisBoot thenfilternoParent gres elsegres warnUnusedGREs gres' warnUnusedLocalBinds,warnUnusedMatches,warnUnusedTypePatterns::[Name ]->FreeVars ->RnM ()warnUnusedLocalBinds =check_unused Opt_WarnUnusedLocalBinds warnUnusedMatches =check_unused Opt_WarnUnusedMatches warnUnusedTypePatterns =check_unused Opt_WarnUnusedTypePatterns check_unused::WarningFlag ->[Name ]->FreeVars ->RnM ()check_unused flag bound_names used_names =whenWOptM flag (warnUnused flag (filterOut (`elemNameSet `used_names )bound_names ))--------------------------- HelperswarnUnusedGREs::[GlobalRdrElt ]->RnM ()warnUnusedGREs gres =mapM_warnUnusedGRE gres warnUnused::WarningFlag ->[Name ]->RnM ()warnUnused flag names =dofld_env <-mkFieldEnv <$>getGlobalRdrEnv mapM_(warnUnused1 flag fld_env )names warnUnused1::WarningFlag ->NameEnv (FieldLabelString ,Name )->Name ->RnM ()warnUnused1 flag fld_env name =when(reportable name occ )$addUnusedWarning flag occ (nameSrcSpan name )(text $"Defined but not used"++opt_str )whereocc =caselookupNameEnv fld_env name ofJust(fl ,_)->mkVarOccFS fl Nothing->nameOccName name opt_str =caseflag ofOpt_WarnUnusedTypePatterns ->" on the right hand side"_->""warnUnusedGRE::GlobalRdrElt ->RnM ()warnUnusedGRE gre @(GRE {gre_name=name ,gre_lcl=lcl ,gre_imp=is })|lcl =dofld_env <-mkFieldEnv <$>getGlobalRdrEnv warnUnused1 Opt_WarnUnusedTopBinds fld_env name |otherwise=when(reportable name occ )(mapM_warn is )whereocc =greOccName gre warn spec =addUnusedWarning Opt_WarnUnusedTopBinds occ span msg wherespan =importSpecLoc spec pp_mod =quotes (ppr (importSpecModule spec ))msg =text "Imported from"<+> pp_mod <+> ptext (sLit "but not used")-- | Make a map from selector names to field labels and parent tycon-- names, to be used when reporting unused record fields.mkFieldEnv::GlobalRdrEnv ->NameEnv (FieldLabelString ,Name )mkFieldEnv rdr_env =mkNameEnv [(gre_namegre ,(lbl ,par_is(gre_pargre )))|gres <-occEnvElts rdr_env ,gre <-gres ,Justlbl <-[greLabel gre ]]-- | Should we report the fact that this 'Name' is unused? The-- 'OccName' may differ from 'nameOccName' due to-- DuplicateRecordFields.reportable::Name ->OccName ->Boolreportable name occ |isWiredInName name =False-- Don't report unused wired-in names-- Otherwise we get a zillion warnings-- from Data.Tuple|otherwise=not(startsWithUnderscore occ )addUnusedWarning::WarningFlag ->OccName ->SrcSpan ->SDoc ->RnM ()addUnusedWarning flag occ span msg =addWarnAt (Reason flag )span $sep [msg <> colon ,nest 2$pprNonVarNameSpace (occNameSpaceocc )<+> quotes (ppr occ )]addNameClashErrRn::RdrName ->[GlobalRdrElt ]->RnM ()addNameClashErrRn rdr_name gres |allisLocalGRE gres &&not(allisRecFldGRE gres )-- If there are two or more *local* defns, we'll have reported=return()-- that already, and we don't want an error cascade|otherwise=addErr (vcat [text "Ambiguous occurrence"<+> quotes (ppr rdr_name ),text "It could refer to",nest 3(vcat (msg1 :msgs ))])where(np1 :nps )=gres msg1 =text "either"<+> ppr_gre np1 msgs =[text " or"<+> ppr_gre np |np <-nps ]ppr_gre gre =sep [pp_gre_name gre <> comma ,pprNameProvenance gre ]-- When printing the name, take care to qualify it in the same-- way as the provenance reported by pprNameProvenance, namely-- the head of 'gre_imp'. Otherwise we get confusing reports like-- Ambiguous occurrence ‘null’-- It could refer to either ‘T15487a.null’,-- imported from ‘Prelude’ at T15487.hs:1:8-13-- or ...-- See Trac #15487pp_gre_name gre @(GRE {gre_name=name ,gre_par=parent ,gre_lcl=lcl ,gre_imp=iss })|FldParent {par_lbl=Justlbl }<-parent =text "the field"<+> quotes (ppr lbl )|otherwise=quotes (pp_qual <> dot <> ppr (nameOccName name ))wherepp_qual |lcl =ppr (nameModule name )|imp :_<-iss -- This 'imp' is the one that-- pprNameProvenance chooses,ImpDeclSpec {is_as=mod }<-is_declimp =ppr mod |otherwise=pprPanic "addNameClassErrRn"(ppr gre $$ ppr iss )-- Invariant: either 'lcl' is True or 'iss' is non-emptyshadowedNameWarn::OccName ->[SDoc ]->SDoc shadowedNameWarn occ shadowed_locs =sep [text "This binding for"<+> quotes (ppr occ )<+> text "shadows the existing binding"<> plural shadowed_locs ,nest 2(vcat shadowed_locs )]unknownSubordinateErr::SDoc ->RdrName ->SDoc unknownSubordinateErr doc op -- Doc is "method of class" or-- "field of constructor"=quotes (ppr op )<+> text "is not a (visible)"<+> doc dupNamesErr::Outputable n =>(n ->SrcSpan )->NE.NonEmptyn ->RnM ()dupNamesErr get_loc names =addErrAt big_loc $vcat [text "Conflicting definitions for"<+> quotes (ppr (NE.headnames )),locations ]wherelocs =mapget_loc (NE.toListnames )big_loc =foldr1combineSrcSpans locs locations =text "Bound at:"<+> vcat (mapppr (sortlocs ))badQualBndrErr::RdrName ->SDoc badQualBndrErr rdr_name =text "Qualified name in binding position:"<+> ppr rdr_name typeAppErr::String->LHsType GhcPs ->SDoc typeAppErr what (L _k )=hang (text "Illegal visible"<+> text what <+> text "application"<+> quotes (char '@'<> ppr k ))2(text "Perhaps you intended to use TypeApplications")checkTupSize::Int->RnM ()checkTupSize tup_size |tup_size <=mAX_TUPLE_SIZE =return()|otherwise=addErr (sep [text "A"<+> int tup_size <> ptext (sLit "-tuple is too large for GHC"),nest 2(parens (text "max size is"<+> int mAX_TUPLE_SIZE )),nest 2(text "Workaround: use nested tuples or define a data type")]){-
************************************************************************
* *
\subsection{Contexts for renaming errors}
* *
************************************************************************
-}-- AZ:TODO: Change these all to be Name instead of RdrName.-- Merge TcType.UserTypeContext in to it.dataHsDocContext =TypeSigCtx SDoc |PatCtx |SpecInstSigCtx |DefaultDeclCtx |ForeignDeclCtx (Located RdrName )|DerivDeclCtx |RuleCtx FastString |TyDataCtx (Located RdrName )|TySynCtx (Located RdrName )|TyFamilyCtx (Located RdrName )|FamPatCtx (Located RdrName )-- The patterns of a type/data family instance|ConDeclCtx [Located Name ]|ClassDeclCtx (Located RdrName )|ExprWithTySigCtx |TypBrCtx |HsTypeCtx |GHCiCtx |SpliceTypeCtx (LHsType GhcPs )|ClassInstanceCtx |GenericCtx SDoc -- Maybe we want to use this more!withHsDocContext::HsDocContext ->SDoc ->SDoc withHsDocContext ctxt doc =doc $$ inHsDocContext ctxt inHsDocContext::HsDocContext ->SDoc inHsDocContext ctxt =text "In"<+> pprHsDocContext ctxt pprHsDocContext::HsDocContext ->SDoc pprHsDocContext (GenericCtx doc )=doc pprHsDocContext(TypeSigCtx doc )=text "the type signature for"<+> doc pprHsDocContextPatCtx =text "a pattern type-signature"pprHsDocContextSpecInstSigCtx =text "a SPECIALISE instance pragma"pprHsDocContextDefaultDeclCtx =text "a `default' declaration"pprHsDocContextDerivDeclCtx =text "a deriving declaration"pprHsDocContext(RuleCtx name )=text "the transformation rule"<+> ftext name pprHsDocContext(TyDataCtx tycon )=text "the data type declaration for"<+> quotes (ppr tycon )pprHsDocContext(FamPatCtx tycon )=text "a type pattern of family instance for"<+> quotes (ppr tycon )pprHsDocContext(TySynCtx name )=text "the declaration for type synonym"<+> quotes (ppr name )pprHsDocContext(TyFamilyCtx name )=text "the declaration for type family"<+> quotes (ppr name )pprHsDocContext(ClassDeclCtx name )=text "the declaration for class"<+> quotes (ppr name )pprHsDocContextExprWithTySigCtx =text "an expression type signature"pprHsDocContextTypBrCtx =text "a Template-Haskell quoted type"pprHsDocContextHsTypeCtx =text "a type argument"pprHsDocContextGHCiCtx =text "GHCi input"pprHsDocContext(SpliceTypeCtx hs_ty )=text "the spliced type"<+> quotes (ppr hs_ty )pprHsDocContextClassInstanceCtx =text "TcSplice.reifyInstances"pprHsDocContext(ForeignDeclCtx name )=text "the foreign declaration for"<+> quotes (ppr name )pprHsDocContext(ConDeclCtx [name ])=text "the definition of data constructor"<+> quotes (ppr name )pprHsDocContext(ConDeclCtx names )=text "the definition of data constructors"<+> interpp'SP names