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