Ticket #7338: 0001-Rework-detection-of-duplicate-signatures-fixes-7338.patch

File 0001-Rework-detection-of-duplicate-signatures-fixes-7338.patch, 6.0 KB (added by michalt, 3 years ago)
  • compiler/hsSyn/HsBinds.lhs

    From 0ed340e7936fa5d6bf3da3ac34197c4015013edb Mon Sep 17 00:00:00 2001
    From: Michal Terepeta <[email protected]>
    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 b import SrcLoc 
    3737import Var
    3838import Bag
    3939import FastString
     40import RdrName ( RdrName )
     41import ListSetOps ( findDupsEq )
    4042
    4143import Data.Data hiding ( Fixity )
    4244import Data.List
    4345import Data.Ord
     46
     47import qualified Data.Map as Map
    4448\end{code}
    4549
    4650%************************************************************************
    hsSigDoc (SpecInstSig {}) = ptext (sLit "SPECIALISE instance pragma") 
    569573hsSigDoc (FixSig {})            = ptext (sLit "fixity declaration")
    570574\end{code}
    571575
    572 Check if signatures overlap; this is used when checking for duplicate
    573 signatures. Since some of the signatures contain a list of names, testing for
    574 equality is not enough -- we have to check if they overlap.
     576For each 'RdrName' or 'Id' we try to find duplicate signatures.  We generate a
     577list of pairs of name and duplicate signatures that refer to that name.
     578Different kind of duplicate signature (e.g., type signatures and INLINE
     579signatures, etc.) are reported as separate pairs.  Also the list of duplicated
     580signatures, for a given name, may have just one element, e.g., when we have
     581  a, a :: Type
     582there is no point in repeating the same signature.
    575583
    576584\begin{code}
    577 overlapHsSig :: Eq a => LSig a -> LSig a -> Bool
    578 overlapHsSig sig1 sig2 = case (unLoc sig1, unLoc sig2) of
    579   (FixSig (FixitySig n1 _), FixSig (FixitySig n2 _)) -> unLoc n1 == unLoc n2
    580   (IdSig n1,                IdSig n2)                -> n1 == n2
    581   (TypeSig ns1 _,           TypeSig ns2 _)           -> ns1 `overlaps_with` ns2
    582   (GenericSig ns1 _,        GenericSig ns2 _)        -> ns1 `overlaps_with` ns2
    583   (InlineSig n1 _,          InlineSig n2 _)          -> unLoc n1 == unLoc n2
    584   -- For specialisations, we don't have equality over HsType, so it's not
    585   -- convenient to spot duplicate specialisations here.  Check for this later,
    586   -- when we're in Type land
    587   (_other1,                 _other2)                 -> False
     585getDuplicateHsSigs :: [LSig RdrName] -> [(Either RdrName Id, [LSig RdrName])]
     586getDuplicateHsSigs signatures = duplicates
    588587  where
    589     ns1 `overlaps_with` ns2 = not (null (intersect (map unLoc ns1) (map unLoc ns2)))
     588    duplicates = concatMap getDuplicates $ Map.toList nameMap
     589
     590    getDuplicates (name, sigs) =
     591      [ (name, nubBy identicalSig dupSigs)
     592        | dupSigs <- findDupsEq sameSigKind sigs, length dupSigs > 1 ]
     593
     594    identicalSig (L l1 _) (L l2 _) = l1 == l2
     595
     596    nameMap = foldl' insertNames Map.empty signatures
     597
     598    insertNames nmap sig = case unLoc sig of
     599      FixSig (FixitySig n _) -> insert (Left $ unLoc n) sig nmap
     600      IdSig n                -> insert (Right n) sig nmap
     601      TypeSig ns _           -> insertList (map (Left . unLoc) ns) sig nmap
     602      GenericSig ns _        -> insertList (map (Left . unLoc) ns) sig nmap
     603      InlineSig n _          -> insert (Left $ unLoc n) sig nmap
     604      -- For specialisations, we don't have equality over HsType, so it's not
     605      -- convenient to spot duplicate specialisations here.  Check for this
     606      -- later, when we're in Type land
     607      _                      -> nmap
     608
     609    insert n s = Map.insertWith (++) n [s]
     610
     611    insertList ns sig nmap = foldl' (\m n -> insert n sig m) nmap ns
     612
     613    sameSigKind sig1 sig2 = case (unLoc sig1, unLoc sig2) of
     614      (FixSig _,        FixSig _)       -> True
     615      (IdSig _,         IdSig _)        -> True
     616      (TypeSig _ _,     TypeSig _ _)    -> True
     617      (GenericSig _ _,  GenericSig _ _) -> True
     618      (InlineSig _ _,   InlineSig _ _)  -> True
     619      _                                 -> False
    590620\end{code}
    591621
    592622\begin{code}
  • compiler/rename/RnBinds.lhs

    diff --git a/compiler/rename/RnBinds.lhs b/compiler/rename/RnBinds.lhs
    index dfead07..653fa0f 100644
    a b import Name 
    4343import NameEnv
    4444import NameSet
    4545import RdrName          ( RdrName, rdrNameOcc )
     46import Var              ( Var )
    4647import SrcLoc
    47 import ListSetOps       ( findDupsEq )
    4848import BasicTypes       ( RecFlag(..) )
    4949import Digraph          ( SCC(..) )
    5050import Bag
    renameSigs :: HsSigCtxt 
    653653           -> RnM ([LSig Name], FreeVars)
    654654-- Renames the signatures and performs error checks
    655655renameSigs ctxt sigs
    656   = do  { mapM_ dupSigDeclErr (findDupsEq overlapHsSig sigs)  -- Duplicate
     656  = do  { mapM_ dupSigDeclErr (getDuplicateHsSigs sigs)
    657657                -- Check for duplicates on RdrName version,
    658658                -- because renamed version has unboundName for
    659659                -- not-in-scope binders, which gives bogus dup-sig errors
    rnGRHS' ctxt rnBody (GRHS guards rhs) 
    848848%************************************************************************
    849849
    850850\begin{code}
    851 dupSigDeclErr :: [LSig RdrName] -> RnM ()
    852 dupSigDeclErr sigs@(L loc sig : _)
    853   = addErrAt loc $
    854         vcat [ptext (sLit "Duplicate") <+> what_it_is <> colon,
    855               nest 2 (vcat (map ppr_sig sigs))]
     851dupSigDeclErr :: (Either RdrName Var, [LSig RdrName]) -> RnM ()
     852dupSigDeclErr (eithername, sigs@(L loc sig : _))
     853  = addErrAt loc $ vcat
     854      [ ptext (sLit "Duplicate") <+> whatItIs <+>
     855        ptext (sLit "for") <+> pprEither eithername <> colon
     856      , nest 2 (vcat (map pprSig sigs)) ]
    856857  where
    857     what_it_is = hsSigDoc sig
    858     ppr_sig (L loc sig) = ppr loc <> colon <+> ppr sig
    859 dupSigDeclErr [] = panic "dupSigDeclErr"
     858    whatItIs = hsSigDoc sig
     859    pprSig (L loc sig) = ppr loc <> colon <+> ppr sig
     860    pprEither (Left n) = ppr n
     861    pprEither (Right n) = ppr n
     862dupSigDeclErr _ = panic "dupSigDeclErr"
    860863
    861864misplacedSigErr :: LSig Name -> RnM ()
    862865misplacedSigErr (L loc sig)