Commit 79723c66 authored by simonpj@microsoft.com's avatar simonpj@microsoft.com
Browse files

Lint should check for duplicate top-level bindings with same qualified name

This would have produced a more civilised error for Trac #4396
parent 814be8d9
......@@ -98,14 +98,30 @@ find an occurence of an Id, we fetch it from the in-scope set.
lintCoreBindings :: [CoreBind] -> (Bag Message, Bag Message)
-- Returns (warnings, errors)
lintCoreBindings binds
= initL (lint_binds binds)
where
= initL $
addLoc TopLevelBindings $
addInScopeVars binders $
-- Put all the top-level binders in scope at the start
-- This is because transformation rules can bring something
-- into use 'unexpectedly'
lint_binds binds = addLoc TopLevelBindings $
addInScopeVars (bindersOfBinds binds) $
mapM lint_bind binds
do { checkL (null dups) (dupVars dups)
; checkL (null ext_dups) (dupExtVars ext_dups)
; mapM lint_bind binds }
where
binders = bindersOfBinds binds
(_, dups) = removeDups compare binders
-- dups_ext checks for names with different uniques
-- but but the same External name M.n. We don't
-- allow this at top level:
-- M.n{r3} = ...
-- M.n{r29} = ...
-- becuase they both get the same linker symbol
ext_dups = findDupsEq eq_ext (map Var.varName binders)
eq_ext n1 n2 | Just m1 <- nameModule_maybe n1
, Just m2 <- nameModule_maybe n2
= m1==m2 && nameOccName n1 == nameOccName n2
| otherwise = False
lint_bind (Rec prs) = mapM_ (lintSingleBinding TopLevel Recursive) prs
lint_bind (NonRec bndr rhs) = lintSingleBinding TopLevel NonRecursive (bndr,rhs)
......@@ -260,10 +276,12 @@ lintCoreExpr (Let (NonRec bndr rhs) body)
lintCoreExpr (Let (Rec pairs) body)
= lintAndScopeIds bndrs $ \_ ->
do { mapM_ (lintSingleBinding NotTopLevel Recursive) pairs
do { checkL (null dups) (dupVars dups)
; mapM_ (lintSingleBinding NotTopLevel Recursive) pairs
; addLoc (BodyOfLetRec bndrs) (lintCoreExpr body) }
where
bndrs = map fst pairs
(_, dups) = removeDups compare bndrs
lintCoreExpr e@(App fun arg)
= do { fun_ty <- lintCoreExpr fun
......@@ -905,12 +923,7 @@ inCasePat = LintM $ \ loc _ errs -> (Just (is_case_pat loc), errs)
addInScopeVars :: [Var] -> LintM a -> LintM a
addInScopeVars vars m
| null dups
= LintM (\ loc subst errs -> unLintM m loc (extendTvInScopeList subst vars) errs)
| otherwise
= failWithL (dupVars dups)
where
(_, dups) = removeDups compare vars
addInScopeVar :: Var -> LintM a -> LintM a
addInScopeVar var m
......@@ -1184,4 +1197,9 @@ dupVars :: [[Var]] -> Message
dupVars vars
= hang (ptext (sLit "Duplicate variables brought into scope"))
2 (ppr vars)
dupExtVars :: [[Name]] -> Message
dupExtVars vars
= hang (ptext (sLit "Duplicate top-level variables with the same qualified name"))
2 (ppr vars)
\end{code}
Markdown is supported
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