From 39fd94e2727715556805a85a7e803c337df950a9 Mon Sep 17 00:00:00 2001 From: "simonpj@microsoft.com" Date: Wed, 6 Sep 2006 22:01:01 +0000 Subject: [PATCH] Check that top-level binders are unqualified names Not having this check led to strange error messages. See test rnfail046. --- compiler/rename/RnEnv.lhs | 44 ++++++++++++++++++++++++------------------- compiler/rename/RnNames.lhs | 9 ++++----- compiler/rename/RnTypes.lhs | 8 +++----- 3 files changed, 32 insertions(+), 29 deletions(-) diff --git a/compiler/rename/RnEnv.lhs b/compiler/rename/RnEnv.lhs index d63c450..91b1269 100644 --- a/compiler/rename/RnEnv.lhs +++ b/compiler/rename/RnEnv.lhs @@ -87,14 +87,14 @@ newTopSrcBinder this_mod mb_parent (L loc rdr_name) -- data T = (,) Int Int -- unless we are in GHC.Tup ASSERT2( isExternalName name, ppr name ) - do checkErr (this_mod == nameModule name) - (badOrigBinding rdr_name) - returnM name + do { checkM (this_mod == nameModule name) + (addErrAt loc (badOrigBinding rdr_name)) + ; return name } | Just (rdr_mod, rdr_occ) <- isOrig_maybe rdr_name - = do checkErr (rdr_mod == this_mod || rdr_mod == rOOT_MAIN) - (badOrigBinding rdr_name) + = do { checkM (rdr_mod == this_mod || rdr_mod == rOOT_MAIN) + (addErrAt loc (badOrigBinding rdr_name)) -- When reading External Core we get Orig names as binders, -- but they should agree with the module gotten from the monad -- @@ -112,11 +112,15 @@ newTopSrcBinder this_mod mb_parent (L loc rdr_name) -- the RdrName, not from the environment. In principle, it'd be fine to -- have an arbitrary mixture of external core definitions in a single module, -- (apart from module-initialisation issues, perhaps). - newGlobalBinder rdr_mod rdr_occ mb_parent - (srcSpanStart loc) --TODO, should pass the whole span + ; newGlobalBinder rdr_mod rdr_occ mb_parent (srcSpanStart loc) } + --TODO, should pass the whole span | otherwise - = newGlobalBinder this_mod (rdrNameOcc rdr_name) mb_parent (srcSpanStart loc) + = do { checkM (not (isQual rdr_name)) + (addErrAt loc (badQualBndrErr rdr_name)) + -- Binders should not be qualified; if they are, and with a different + -- module name, we we get a confusing "M.T is not in scope" error later + ; newGlobalBinder this_mod (rdrNameOcc rdr_name) mb_parent (srcSpanStart loc) } \end{code} %********************************************************* @@ -445,10 +449,9 @@ lookupFixityRn name --------------- lookupTyFixityRn :: Located Name -> RnM Fixity lookupTyFixityRn (L loc n) - = doptM Opt_GlasgowExts `thenM` \ glaExts -> - when (not glaExts) - (setSrcSpan loc $ addWarn (infixTyConWarn n)) `thenM_` - lookupFixityRn n + = do { glaExts <- doptM Opt_GlasgowExts + ; when (not glaExts) (addWarnAt loc (infixTyConWarn n)) + ; lookupFixityRn n } --------------- dataTcOccs :: RdrName -> [RdrName] @@ -676,7 +679,7 @@ checkShadowing doc_str loc_rdr_names check_shadow (L loc rdr_name) | rdr_name `elemLocalRdrEnv` local_env || not (null (lookupGRE_RdrName rdr_name global_env )) - = setSrcSpan loc $ addWarn (shadowedNameWarn doc_str rdr_name) + = addWarnAt loc (shadowedNameWarn doc_str rdr_name) | otherwise = returnM () in mappM_ check_shadow loc_rdr_names @@ -710,7 +713,7 @@ warnUnusedModules :: [(ModuleName,SrcSpan)] -> RnM () warnUnusedModules mods = ifOptM Opt_WarnUnusedImports (mappM_ bleat mods) where - bleat (mod,loc) = setSrcSpan loc $ addWarn (mk_warn mod) + bleat (mod,loc) = addWarnAt loc (mk_warn mod) mk_warn m = vcat [ptext SLIT("Module") <+> quotes (ppr m) <+> text "is imported, but nothing from it is used,", nest 2 (ptext SLIT("except perhaps instances visible in") @@ -765,10 +768,11 @@ warnUnusedName (name, prov) \end{code} \begin{code} -addNameClashErrRn rdr_name (np1:nps) +addNameClashErrRn rdr_name names = addErr (vcat [ptext SLIT("Ambiguous occurrence") <+> quotes (ppr rdr_name), ptext SLIT("It could refer to") <+> vcat (msg1 : msgs)]) where + (np1:nps) = names msg1 = ptext SLIT("either") <+> mk_ref np1 msgs = [ptext SLIT(" or") <+> mk_ref np | np <- nps] mk_ref gre = quotes (ppr (gre_name gre)) <> comma <+> pprNameProvenance gre @@ -793,10 +797,9 @@ badOrigBinding name dupNamesErr :: SDoc -> [Located RdrName] -> RnM () dupNamesErr descriptor located_names - = setSrcSpan big_loc $ - addErr (vcat [ptext SLIT("Conflicting definitions for") <+> quotes (ppr name1), - locations, - descriptor]) + = addErrAt big_loc $ + vcat [ptext SLIT("Conflicting definitions for") <+> quotes (ppr name1), + locations, descriptor] where L _ name1 = head located_names locs = map getLoc located_names @@ -806,6 +809,9 @@ dupNamesErr descriptor located_names | otherwise = ptext SLIT("Bound at:") <+> vcat (map ppr (sortLe (<=) locs)) +badQualBndrErr rdr_name + = ptext SLIT("Qualified name in binding position:") <+> ppr rdr_name + infixTyConWarn op = vcat [ftext FSLIT("Accepting non-standard infix type constructor") <+> quotes (ppr op), ftext FSLIT("Use -fglasgow-exts to avoid this warning")] diff --git a/compiler/rename/RnNames.lhs b/compiler/rename/RnNames.lhs index b1f3795..d16e3d6 100644 --- a/compiler/rename/RnNames.lhs +++ b/compiler/rename/RnNames.lhs @@ -151,10 +151,9 @@ rnImportDecl' iface decl_spec (ImportDecl mod_name want_boot qual_only as_mod (J return $ ImportDecl mod_name want_boot qual_only as_mod (Just (want_hiding,rn_import_items)) where srcSpanWrapper (L span ieRdr) - = setSrcSpan span $ - case get_item ieRdr of + = case get_item ieRdr of Nothing - -> do addErr (badImportItemErr iface decl_spec ieRdr) + -> do addErrAt span (badImportItemErr iface decl_spec ieRdr) return Nothing Just ieNames -> return (Just [L span ie | ie <- ieNames]) @@ -753,8 +752,8 @@ reportDeprecations dflags tcg_env check hpt pit (GRE {gre_name = name, gre_prov = Imported (imp_spec:_)}) | name `elemNameSet` used_names , Just deprec_txt <- lookupDeprec dflags hpt pit name - = setSrcSpan (importSpecLoc imp_spec) $ - addWarn (sep [ptext SLIT("Deprecated use of") <+> + = addWarnAt (importSpecLoc imp_spec) + (sep [ptext SLIT("Deprecated use of") <+> pprNonVarNameSpace (occNameSpace (nameOccName name)) <+> quotes (ppr name), (parens imp_msg) <> colon, diff --git a/compiler/rename/RnTypes.lhs b/compiler/rename/RnTypes.lhs index e209036..055cd34 100644 --- a/compiler/rename/RnTypes.lhs +++ b/compiler/rename/RnTypes.lhs @@ -752,12 +752,10 @@ checkTupSize tup_size forAllWarn doc ty (L loc tyvar) = ifOptM Opt_WarnUnusedMatches $ - setSrcSpan loc $ - addWarn (sep [ptext SLIT("The universally quantified type variable") <+> quotes (ppr tyvar), - nest 4 (ptext SLIT("does not appear in the type") <+> quotes (ppr ty))] + addWarnAt loc (sep [ptext SLIT("The universally quantified type variable") <+> quotes (ppr tyvar), + nest 4 (ptext SLIT("does not appear in the type") <+> quotes (ppr ty))] $$ - doc - ) + doc) bogusCharError c = ptext SLIT("character literal out of range: '\\") <> char c <> char '\'' -- 1.7.10.4