summary |
shortlog |
log |
commit | commitdiff |
tree
raw |
patch |
inline | side by side (from parent 1:
b67039a)
Not having this check led to strange error messages.
See test rnfail046.
-- data T = (,) Int Int
-- unless we are in GHC.Tup
ASSERT2( isExternalName name, ppr 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
| 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
--
-- When reading External Core we get Orig names as binders,
-- but they should agree with the module gotten from the monad
--
-- 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).
-- 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
- = 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}
%*********************************************************
\end{code}
%*********************************************************
---------------
lookupTyFixityRn :: Located Name -> RnM Fixity
lookupTyFixityRn (L loc n)
---------------
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]
---------------
dataTcOccs :: RdrName -> [RdrName]
check_shadow (L loc rdr_name)
| rdr_name `elemLocalRdrEnv` local_env
|| not (null (lookupGRE_RdrName rdr_name global_env ))
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
| otherwise = returnM ()
in
mappM_ check_shadow loc_rdr_names
warnUnusedModules mods
= ifOptM Opt_WarnUnusedImports (mappM_ bleat mods)
where
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")
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")
-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
= addErr (vcat [ptext SLIT("Ambiguous occurrence") <+> quotes (ppr rdr_name),
ptext SLIT("It could refer to") <+> vcat (msg1 : msgs)])
where
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
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
dupNamesErr :: SDoc -> [Located RdrName] -> RnM ()
dupNamesErr descriptor located_names
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
where
L _ name1 = head located_names
locs = map getLoc located_names
| otherwise = ptext SLIT("Bound at:") <+>
vcat (map ppr (sortLe (<=) locs))
| 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")]
infixTyConWarn op
= vcat [ftext FSLIT("Accepting non-standard infix type constructor") <+> quotes (ppr op),
ftext FSLIT("Use -fglasgow-exts to avoid this warning")]
return $ ImportDecl mod_name want_boot qual_only as_mod (Just (want_hiding,rn_import_items))
where
srcSpanWrapper (L span ieRdr)
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
- -> 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])
return Nothing
Just ieNames
-> return (Just [L span ie | ie <- ieNames])
check hpt pit (GRE {gre_name = name, gre_prov = Imported (imp_spec:_)})
| name `elemNameSet` used_names
, Just deprec_txt <- lookupDeprec dflags hpt pit name
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,
pprNonVarNameSpace (occNameSpace (nameOccName name)) <+>
quotes (ppr name),
(parens imp_msg) <> colon,
forAllWarn doc ty (L loc tyvar)
= ifOptM Opt_WarnUnusedMatches $
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))]
bogusCharError c
= ptext SLIT("character literal out of range: '\\") <> char c <> char '\''
bogusCharError c
= ptext SLIT("character literal out of range: '\\") <> char c <> char '\''