diff options
Diffstat (limited to 'compiler/GHC/Rename/Utils.hs')
| -rw-r--r-- | compiler/GHC/Rename/Utils.hs | 49 |
1 files changed, 28 insertions, 21 deletions
diff --git a/compiler/GHC/Rename/Utils.hs b/compiler/GHC/Rename/Utils.hs index 2edd8a2663..5787335514 100644 --- a/compiler/GHC/Rename/Utils.hs +++ b/compiler/GHC/Rename/Utils.hs @@ -9,7 +9,7 @@ This module contains miscellaneous functions related to renaming. -} module GHC.Rename.Utils ( - checkDupRdrNames, checkShadowedRdrNames, + checkDupRdrNames, checkDupRdrNamesN, checkShadowedRdrNames, checkDupNames, checkDupAndShadowedNames, dupNamesErr, checkTupSize, checkCTupSize, addFvRn, mapFvRn, mapMaybeFvRn, @@ -69,7 +69,7 @@ import qualified GHC.LanguageExtensions as LangExt ********************************************************* -} -newLocalBndrRn :: Located RdrName -> RnM Name +newLocalBndrRn :: LocatedN RdrName -> RnM Name -- Used for non-top-level binders. These should -- never be qualified. newLocalBndrRn (L loc rdr_name) @@ -78,11 +78,11 @@ newLocalBndrRn (L loc rdr_name) -- See Note [Binders in Template Haskell] in "GHC.ThToHs" | otherwise = do { unless (isUnqual rdr_name) - (addErrAt loc (badQualBndrErr rdr_name)) + (addErrAt (locA loc) (badQualBndrErr rdr_name)) ; uniq <- newUnique - ; return (mkInternalName uniq (rdrNameOcc rdr_name) loc) } + ; return (mkInternalName uniq (rdrNameOcc rdr_name) (locA loc)) } -newLocalBndrsRn :: [Located RdrName] -> RnM [Name] +newLocalBndrsRn :: [LocatedN RdrName] -> RnM [Name] newLocalBndrsRn = mapM newLocalBndrRn bindLocalNames :: [Name] -> RnM a -> RnM a @@ -107,10 +107,17 @@ extendTyVarEnvFVRn :: [Name] -> RnM (a, FreeVars) -> RnM (a, FreeVars) extendTyVarEnvFVRn tyvars thing_inside = bindLocalNamesFV tyvars thing_inside ------------------------------------- -checkDupRdrNames :: [Located RdrName] -> RnM () +checkDupRdrNames :: [LocatedN RdrName] -> RnM () -- Check for duplicated names in a binding group checkDupRdrNames rdr_names_w_loc - = mapM_ (dupNamesErr getLoc) dups + = mapM_ (dupNamesErr getLocA) dups + where + (_, dups) = removeDups (\n1 n2 -> unLoc n1 `compare` unLoc n2) rdr_names_w_loc + +checkDupRdrNamesN :: [LocatedN RdrName] -> RnM () +-- Check for duplicated names in a binding group +checkDupRdrNamesN rdr_names_w_loc + = mapM_ (dupNamesErr getLocA) dups where (_, dups) = removeDups (\n1 n2 -> unLoc n1 `compare` unLoc n2) rdr_names_w_loc @@ -126,14 +133,14 @@ check_dup_names names (_, dups) = removeDups (\n1 n2 -> nameOccName n1 `compare` nameOccName n2) names --------------------- -checkShadowedRdrNames :: [Located RdrName] -> RnM () +checkShadowedRdrNames :: [LocatedN RdrName] -> RnM () checkShadowedRdrNames loc_rdr_names = do { envs <- getRdrEnvs ; checkShadowedOccs envs get_loc_occ filtered_rdrs } where filtered_rdrs = filterOut (isExact . unLoc) loc_rdr_names -- See Note [Binders in Template Haskell] in "GHC.ThToHs" - get_loc_occ (L loc rdr) = (loc,rdrNameOcc rdr) + get_loc_occ (L loc rdr) = (locA loc,rdrNameOcc rdr) checkDupAndShadowedNames :: (GlobalRdrEnv, LocalRdrEnv) -> [Name] -> RnM () checkDupAndShadowedNames envs names @@ -289,13 +296,13 @@ noNestedForallsContextsErr what lty = -- types of terms, so we give a slightly more descriptive error -- message in the event that they contain visible dependent -- quantification (currently only allowed in kinds). - -> Just (l, vcat [ text "Illegal visible, dependent quantification" <+> - text "in the type of a term" - , text "(GHC does not yet support this)" ]) + -> Just (locA l, vcat [ text "Illegal visible, dependent quantification" <+> + text "in the type of a term" + , text "(GHC does not yet support this)" ]) | HsForAllInvis{} <- tele - -> Just (l, nested_foralls_contexts_err) + -> Just (locA l, nested_foralls_contexts_err) L l (HsQualTy {}) - -> Just (l, nested_foralls_contexts_err) + -> Just (locA l, nested_foralls_contexts_err) _ -> Nothing where nested_foralls_contexts_err = @@ -647,15 +654,15 @@ data HsDocContext | PatCtx | SpecInstSigCtx | DefaultDeclCtx - | ForeignDeclCtx (Located RdrName) + | ForeignDeclCtx (LocatedN 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) + | TyDataCtx (LocatedN RdrName) + | TySynCtx (LocatedN RdrName) + | TyFamilyCtx (LocatedN RdrName) + | FamPatCtx (LocatedN RdrName) -- The patterns of a type/data family instance + | ConDeclCtx [LocatedN Name] + | ClassDeclCtx (LocatedN RdrName) | ExprWithTySigCtx | TypBrCtx | HsTypeCtx |