Commit 479f9fcb authored by simonpj@microsoft.com's avatar simonpj@microsoft.com
Browse files

Fix Trac #2293: improve error reporting for duplicate declarations

parent 48565ca8
......@@ -29,7 +29,7 @@ module RdrName (
lookupGlobalRdrEnv, extendGlobalRdrEnv,
pprGlobalRdrEnv, globalRdrEnvElts,
lookupGRE_RdrName, lookupGRE_Name, getGRE_NameQualifier_maybes,
hideSomeUnquals,
hideSomeUnquals, findLocalDupsRdrEnv,
-- GlobalRdrElt, Provenance, ImportSpec
GlobalRdrElt(..), isLocalGRE, unQualOK, qualSpecOK, unQualSpecOK,
......@@ -463,6 +463,27 @@ mkGlobalRdrEnv gres
(nameOccName (gre_name gre))
[gre]
findLocalDupsRdrEnv :: GlobalRdrEnv -> [OccName] -> (GlobalRdrEnv, [[Name]])
-- For each OccName, see if there are multiple LocalDef definitions
-- for it. If so, remove all but one (to suppress subsequent error messages)
-- and return a list of the duplicate bindings
findLocalDupsRdrEnv rdr_env occs
= go rdr_env [] occs
where
go rdr_env dups [] = (rdr_env, dups)
go rdr_env dups (occ:occs)
= case filter isLocalGRE gres of
[] -> WARN( True, ppr occ <+> ppr rdr_env )
go rdr_env dups occs -- Weird! No binding for occ
[_] -> go rdr_env dups occs -- The common case
dup_gres -> go (extendOccEnv rdr_env occ (head dup_gres : nonlocal_gres))
(map gre_name dup_gres : dups)
occs
where
gres = lookupOccEnv rdr_env occ `orElse` []
nonlocal_gres = filterOut isLocalGRE gres
insertGRE :: GlobalRdrElt -> [GlobalRdrElt] -> [GlobalRdrElt]
insertGRE new_g [] = [new_g]
insertGRE new_g (old_g : old_gs)
......
......@@ -304,30 +304,28 @@ extendGlobalRdrEnvRn shadowP avails new_fixities
(rdr_env2, lcl_env2) | shadowP = (rdr_env1, lcl_env1)
| otherwise = (rdr_env, lcl_env)
; (rdr_env', fix_env') <- foldlM extend (rdr_env2, fix_env) gres
rdr_env3 = foldl extendGlobalRdrEnv rdr_env2 gres
fix_env' = foldl extend_fix_env fix_env gres
(rdr_env', dups) = findLocalDupsRdrEnv rdr_env3 new_occs
gbl_env' = gbl_env { tcg_rdr_env = rdr_env', tcg_fix_env = fix_env' }
; mapM_ addDupDeclErr dups
; let gbl_env' = gbl_env { tcg_rdr_env = rdr_env', tcg_fix_env = fix_env' }
; traceRn (text "extendGlobalRdrEnvRn" <+> (ppr new_fixities $$ ppr fix_env $$ ppr fix_env'))
; return (gbl_env', lcl_env2) }
where
gres = gresFromAvails LocalDef avails
extend envs@(cur_rdr_env, _cur_fix_env) gre
= let gres = lookupGlobalRdrEnv cur_rdr_env (nameOccName (gre_name gre))
in case filter isLocalGRE gres of -- Check for existing *local* defns
dup_gre:_ -> do { addDupDeclErr (gre_name dup_gre) (gre_name gre)
; return envs }
[] -> return (simple_extend envs gre)
simple_extend (rdr_env, fix_env) gre
= (extendGlobalRdrEnv rdr_env gre, fix_env')
where
-- If there is a fixity decl for the gre, add it to the fixity env
extend_fix_env fix_env gre
| Just (L _ fi) <- lookupFsEnv new_fixities (occNameFS occ)
= extendNameEnv fix_env name (FixItem occ fi)
| otherwise
= fix_env
where
name = gre_name gre
occ = nameOccName name
fix_env' = case lookupFsEnv new_fixities (occNameFS occ) of
Nothing -> fix_env
Just (L _ fi) -> extendNameEnv fix_env name (FixItem occ fi)
\end{code}
@getLocalDeclBinders@ returns the names for an @HsDecl@. It's
......@@ -1398,16 +1396,16 @@ exportClashErr global_env name1 name2 ie1 ie2
then (name1, ie1, name2, ie2)
else (name2, ie2, name1, ie1)
addDupDeclErr :: Name -> Name -> TcRn ()
addDupDeclErr name_a name_b
= addErrAt (srcLocSpan loc2) $
vcat [ptext (sLit "Multiple declarations of") <+> quotes (ppr name1),
ptext (sLit "Declared at:") <+> vcat [ppr (nameSrcLoc name1), ppr loc2]]
where
loc2 = nameSrcLoc name2
(name1,name2) | nameSrcLoc name_a > nameSrcLoc name_b = (name_b,name_a)
| otherwise = (name_a,name_b)
addDupDeclErr :: [Name] -> TcRn ()
addDupDeclErr []
= panic "addDupDeclErr: empty list"
addDupDeclErr names@(name : _)
= addErrAt (getSrcSpan (last sorted_names)) $
-- Report the error at the later location
vcat [ptext (sLit "Multiple declarations of") <+> quotes (ppr name),
ptext (sLit "Declared at:") <+> vcat (map (ppr . nameSrcLoc) sorted_names)]
where
sorted_names = sortWith nameSrcLoc names
dupExportWarn :: OccName -> IE RdrName -> IE RdrName -> SDoc
dupExportWarn occ_name ie1 ie2
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment