Ticket #5589: 0001-Fix-duplicate-type-signature-error-ticket-5589.patch

File 0001-Fix-duplicate-type-signature-error-ticket-5589.patch, 3.4 KB (added by michalt, 4 years ago)
  • compiler/hsSyn/HsBinds.lhs

    From fe8a53fc7039b879f4a478e549a52fba616c32aa Mon Sep 17 00:00:00 2001
    From: Michal Terepeta <[email protected]>
    Date: Sun, 30 Oct 2011 12:20:44 +0100
    Subject: [PATCH 1/2] Fix duplicate type signature error (ticket #5589).
    
    ---
     compiler/hsSyn/HsBinds.lhs  |   29 ++++++++++++++++++-----------
     compiler/rename/RnBinds.lhs |    2 +-
     2 files changed, 19 insertions(+), 12 deletions(-)
    
    diff --git a/compiler/hsSyn/HsBinds.lhs b/compiler/hsSyn/HsBinds.lhs
    index 7a5cd3b..410f1d4 100644
    a b import FastString 
    4040 
    4141import Data.IORef( IORef ) 
    4242import Data.Data hiding ( Fixity ) 
     43 
     44import Data.List ( intersect ) 
    4345\end{code} 
    4446 
    4547%************************************************************************ 
    hsSigDoc (SpecInstSig {}) = ptext (sLit "SPECIALISE instance pragma") 
    772774hsSigDoc (FixSig {})            = ptext (sLit "fixity declaration") 
    773775\end{code} 
    774776 
    775 Signature equality is used when checking for duplicate signatures 
     777Check if signatures overlap; this is used when checking for duplicate 
     778signatures. Since some of the signatures contain a list of names, testing for 
     779equality is not enough -- we have to check if they overlap. 
    776780 
    777781\begin{code} 
    778 eqHsSig :: Eq a => LSig a -> LSig a -> Bool 
    779 eqHsSig (L _ (FixSig (FixitySig n1 _))) (L _ (FixSig (FixitySig n2 _))) = unLoc n1 == unLoc n2 
    780 eqHsSig (L _ (IdSig n1))                (L _ (IdSig n2))                = n1 == n2 
    781 eqHsSig (L _ (TypeSig ns1 _))           (L _ (TypeSig ns2 _))           = map unLoc ns1 == map unLoc ns2 
    782 eqHsSig (L _ (GenericSig ns1 _))        (L _ (GenericSig ns2 _))        = map unLoc ns1 == map unLoc ns2 
    783 eqHsSig (L _ (InlineSig n1 _))          (L _ (InlineSig n2 _))          = unLoc n1 == unLoc n2 
    784         -- For specialisations, we don't have equality over 
    785         -- HsType, so it's not convenient to spot duplicate  
    786         -- specialisations here.  Check for this later, when we're in Type land 
    787 eqHsSig _other1 _other2 = False 
     782overlapHsSig :: Eq a => LSig a -> LSig a -> Bool 
     783overlapHsSig sig1 sig2 = case (unLoc sig1, unLoc sig2) of 
     784  (FixSig (FixitySig n1 _), FixSig (FixitySig n2 _)) -> unLoc n1 == unLoc n2 
     785  (IdSig n1,                IdSig n2)                -> n1 == n2 
     786  (TypeSig ns1 _,           TypeSig ns2 _)           -> not . null $ overlap ns1 ns2 
     787  (GenericSig ns1 _,        GenericSig ns2 _)        -> not . null $ overlap ns1 ns2 
     788  (InlineSig n1 _,          InlineSig n2 _)          -> unLoc n1 == unLoc n2 
     789  -- For specialisations, we don't have equality over HsType, so it's not 
     790  -- convenient to spot duplicate specialisations here.  Check for this later, 
     791  -- when we're in Type land 
     792  (_other1,                 _other2)                 -> False 
     793  where 
     794    overlap ns1 ns2 = intersect (map unLoc ns1) (map unLoc ns2) 
    788795\end{code} 
    789796 
    790797\begin{code} 
  • compiler/rename/RnBinds.lhs

    diff --git a/compiler/rename/RnBinds.lhs b/compiler/rename/RnBinds.lhs
    index e606323..72d58ea 100644
    a b renameSigs :: HsSigCtxt 
    644644           -> RnM [LSig Name] 
    645645-- Renames the signatures and performs error checks 
    646646renameSigs ctxt sigs  
    647   = do  { mapM_ dupSigDeclErr (findDupsEq eqHsSig sigs)  -- Duplicate 
     647  = do  { mapM_ dupSigDeclErr (findDupsEq overlapHsSig sigs)  -- Duplicate 
    648648                -- Check for duplicates on RdrName version,  
    649649                -- because renamed version has unboundName for 
    650650                -- not-in-scope binders, which gives bogus dup-sig errors