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

Check for duplicate bindings in CoreLint

parent 3e1c50a6
% %
% (c) The University of Glasgow 2006 % (c) The University of Glasgow 2006
% (c) The GRASP/AQUA Project, Glasgow University, 1993-1998 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
...@@ -42,6 +43,7 @@ import Coercion ...@@ -42,6 +43,7 @@ import Coercion
import TyCon import TyCon
import BasicTypes import BasicTypes
import StaticFlags import StaticFlags
import ListSetOps
import DynFlags import DynFlags
import Outputable import Outputable
import Util import Util
...@@ -177,7 +179,8 @@ lintCoreBindings dflags whoDunnit binds ...@@ -177,7 +179,8 @@ lintCoreBindings dflags whoDunnit binds
-- Put all the top-level binders in scope at the start -- Put all the top-level binders in scope at the start
-- This is because transformation rules can bring something -- This is because transformation rules can bring something
-- into use 'unexpectedly' -- into use 'unexpectedly'
lint_binds binds = addInScopeVars (bindersOfBinds binds) $ lint_binds binds = addLoc TopLevelBindings $
addInScopeVars (bindersOfBinds binds) $
mapM lint_bind binds mapM lint_bind binds
lint_bind (Rec prs) = mapM_ (lintSingleBinding TopLevel Recursive) prs lint_bind (Rec prs) = mapM_ (lintSingleBinding TopLevel Recursive) prs
...@@ -641,6 +644,7 @@ data LintLocInfo ...@@ -641,6 +644,7 @@ data LintLocInfo
| CasePat CoreAlt -- *Pattern* of the case alternative | CasePat CoreAlt -- *Pattern* of the case alternative
| AnExpr CoreExpr -- Some expression | AnExpr CoreExpr -- Some expression
| ImportedUnfolding SrcLoc -- Some imported unfolding (ToDo: say which) | ImportedUnfolding SrcLoc -- Some imported unfolding (ToDo: say which)
| TopLevelBindings
\end{code} \end{code}
...@@ -678,8 +682,13 @@ addLoc extra_loc m = ...@@ -678,8 +682,13 @@ addLoc extra_loc m =
LintM (\ loc subst errs -> unLintM m (extra_loc:loc) subst errs) LintM (\ loc subst errs -> unLintM m (extra_loc:loc) subst errs)
addInScopeVars :: [Var] -> LintM a -> LintM a addInScopeVars :: [Var] -> LintM a -> LintM a
addInScopeVars vars m = addInScopeVars vars m
LintM (\ loc subst errs -> unLintM m loc (extendTvInScope subst vars) errs) | null dups
= LintM (\ loc subst errs -> unLintM m loc (extendTvInScope subst vars) errs)
| otherwise
= addErrL (dupVars dups)
where
(_, dups) = removeDups compare vars
updateTvSubst :: TvSubst -> LintM a -> LintM a updateTvSubst :: TvSubst -> LintM a -> LintM a
updateTvSubst subst' m = updateTvSubst subst' m =
...@@ -767,6 +776,8 @@ dumpLoc (CasePat (con, args, rhs)) ...@@ -767,6 +776,8 @@ dumpLoc (CasePat (con, args, rhs))
dumpLoc (ImportedUnfolding locn) dumpLoc (ImportedUnfolding locn)
= (locn, brackets (ptext SLIT("in an imported unfolding"))) = (locn, brackets (ptext SLIT("in an imported unfolding")))
dumpLoc TopLevelBindings
= (noSrcLoc, empty)
pp_binders :: [Var] -> SDoc pp_binders :: [Var] -> SDoc
pp_binders bs = sep (punctuate comma (map pp_binder bs)) pp_binders bs = sep (punctuate comma (map pp_binder bs))
...@@ -919,6 +930,10 @@ mkCastErr from_ty expr_ty ...@@ -919,6 +930,10 @@ mkCastErr from_ty expr_ty
ptext SLIT("Type of enclosed expr:") <+> ppr expr_ty ptext SLIT("Type of enclosed expr:") <+> ppr expr_ty
] ]
dupVars vars
= hang (ptext SLIT("Duplicate variables brought into scope"))
2 (ppr vars)
mkStrangeTyMsg e mkStrangeTyMsg e
= ptext SLIT("Type where expression expected:") <+> ppr e = ptext SLIT("Type where expression expected:") <+> ppr e
\end{code} \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