From 0ed340e7936fa5d6bf3da3ac34197c4015013edb Mon Sep 17 00:00:00 2001 From: Michal Terepeta Date: Mon, 22 Oct 2012 19:01:38 +0200 Subject: [PATCH] Rework detection of duplicate signatures (fixes #7338) --- compiler/hsSyn/HsBinds.lhs | 60 +++++++++++++++++++++++++++++++++------------ compiler/rename/RnBinds.lhs | 23 +++++++++-------- 2 files changed, 58 insertions(+), 25 deletions(-) diff --git a/compiler/hsSyn/HsBinds.lhs b/compiler/hsSyn/HsBinds.lhs index f15ef5d..440c1ad 100644 --- a/compiler/hsSyn/HsBinds.lhs +++ b/compiler/hsSyn/HsBinds.lhs @@ -37,10 +37,14 @@ import SrcLoc import Var import Bag import FastString +import RdrName ( RdrName ) +import ListSetOps ( findDupsEq ) import Data.Data hiding ( Fixity ) import Data.List import Data.Ord + +import qualified Data.Map as Map \end{code} %************************************************************************ @@ -569,24 +573,50 @@ hsSigDoc (SpecInstSig {}) = ptext (sLit "SPECIALISE instance pragma") hsSigDoc (FixSig {}) = ptext (sLit "fixity declaration") \end{code} -Check if signatures overlap; this is used when checking for duplicate -signatures. Since some of the signatures contain a list of names, testing for -equality is not enough -- we have to check if they overlap. +For each 'RdrName' or 'Id' we try to find duplicate signatures. We generate a +list of pairs of name and duplicate signatures that refer to that name. +Different kind of duplicate signature (e.g., type signatures and INLINE +signatures, etc.) are reported as separate pairs. Also the list of duplicated +signatures, for a given name, may have just one element, e.g., when we have + a, a :: Type +there is no point in repeating the same signature. \begin{code} -overlapHsSig :: Eq a => LSig a -> LSig a -> Bool -overlapHsSig sig1 sig2 = case (unLoc sig1, unLoc sig2) of - (FixSig (FixitySig n1 _), FixSig (FixitySig n2 _)) -> unLoc n1 == unLoc n2 - (IdSig n1, IdSig n2) -> n1 == n2 - (TypeSig ns1 _, TypeSig ns2 _) -> ns1 `overlaps_with` ns2 - (GenericSig ns1 _, GenericSig ns2 _) -> ns1 `overlaps_with` ns2 - (InlineSig n1 _, InlineSig n2 _) -> unLoc n1 == unLoc n2 - -- For specialisations, we don't have equality over HsType, so it's not - -- convenient to spot duplicate specialisations here. Check for this later, - -- when we're in Type land - (_other1, _other2) -> False +getDuplicateHsSigs :: [LSig RdrName] -> [(Either RdrName Id, [LSig RdrName])] +getDuplicateHsSigs signatures = duplicates where - ns1 `overlaps_with` ns2 = not (null (intersect (map unLoc ns1) (map unLoc ns2))) + duplicates = concatMap getDuplicates $ Map.toList nameMap + + getDuplicates (name, sigs) = + [ (name, nubBy identicalSig dupSigs) + | dupSigs <- findDupsEq sameSigKind sigs, length dupSigs > 1 ] + + identicalSig (L l1 _) (L l2 _) = l1 == l2 + + nameMap = foldl' insertNames Map.empty signatures + + insertNames nmap sig = case unLoc sig of + FixSig (FixitySig n _) -> insert (Left $ unLoc n) sig nmap + IdSig n -> insert (Right n) sig nmap + TypeSig ns _ -> insertList (map (Left . unLoc) ns) sig nmap + GenericSig ns _ -> insertList (map (Left . unLoc) ns) sig nmap + InlineSig n _ -> insert (Left $ unLoc n) sig nmap + -- For specialisations, we don't have equality over HsType, so it's not + -- convenient to spot duplicate specialisations here. Check for this + -- later, when we're in Type land + _ -> nmap + + insert n s = Map.insertWith (++) n [s] + + insertList ns sig nmap = foldl' (\m n -> insert n sig m) nmap ns + + sameSigKind sig1 sig2 = case (unLoc sig1, unLoc sig2) of + (FixSig _, FixSig _) -> True + (IdSig _, IdSig _) -> True + (TypeSig _ _, TypeSig _ _) -> True + (GenericSig _ _, GenericSig _ _) -> True + (InlineSig _ _, InlineSig _ _) -> True + _ -> False \end{code} \begin{code} diff --git a/compiler/rename/RnBinds.lhs b/compiler/rename/RnBinds.lhs index dfead07..653fa0f 100644 --- a/compiler/rename/RnBinds.lhs +++ b/compiler/rename/RnBinds.lhs @@ -43,8 +43,8 @@ import Name import NameEnv import NameSet import RdrName ( RdrName, rdrNameOcc ) +import Var ( Var ) import SrcLoc -import ListSetOps ( findDupsEq ) import BasicTypes ( RecFlag(..) ) import Digraph ( SCC(..) ) import Bag @@ -653,7 +653,7 @@ renameSigs :: HsSigCtxt -> RnM ([LSig Name], FreeVars) -- Renames the signatures and performs error checks renameSigs ctxt sigs - = do { mapM_ dupSigDeclErr (findDupsEq overlapHsSig sigs) -- Duplicate + = do { mapM_ dupSigDeclErr (getDuplicateHsSigs sigs) -- Check for duplicates on RdrName version, -- because renamed version has unboundName for -- not-in-scope binders, which gives bogus dup-sig errors @@ -848,15 +848,18 @@ rnGRHS' ctxt rnBody (GRHS guards rhs) %************************************************************************ \begin{code} -dupSigDeclErr :: [LSig RdrName] -> RnM () -dupSigDeclErr sigs@(L loc sig : _) - = addErrAt loc $ - vcat [ptext (sLit "Duplicate") <+> what_it_is <> colon, - nest 2 (vcat (map ppr_sig sigs))] +dupSigDeclErr :: (Either RdrName Var, [LSig RdrName]) -> RnM () +dupSigDeclErr (eithername, sigs@(L loc sig : _)) + = addErrAt loc $ vcat + [ ptext (sLit "Duplicate") <+> whatItIs <+> + ptext (sLit "for") <+> pprEither eithername <> colon + , nest 2 (vcat (map pprSig sigs)) ] where - what_it_is = hsSigDoc sig - ppr_sig (L loc sig) = ppr loc <> colon <+> ppr sig -dupSigDeclErr [] = panic "dupSigDeclErr" + whatItIs = hsSigDoc sig + pprSig (L loc sig) = ppr loc <> colon <+> ppr sig + pprEither (Left n) = ppr n + pprEither (Right n) = ppr n +dupSigDeclErr _ = panic "dupSigDeclErr" misplacedSigErr :: LSig Name -> RnM () misplacedSigErr (L loc sig) -- 1.8.0