[commit: ghc] wip/T9156: Fixed issue with detection of duplicate record fields (fixes #9156) (7372bce)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/T9156
Link       : http://ghc.haskell.org/trac/ghc/changeset/7372bce33716d83caf1f666e8225768561bdaf16/ghc

>---------------------------------------------------------------

commit 7372bce33716d83caf1f666e8225768561bdaf16
Author: Gintautas Miliauskas <gintautas.miliauskas at gmail.com>
Date:   Sat Jun 7 15:38:56 2014 +0000

    Fixed issue with detection of duplicate record fields (fixes #9156)
    
    Summary:
    Duplicate record fields would not be detected when given a type
    with multiple data constructors, and the first data constructor
    had a record field r1 and any consecutive data constructors
    had multiple fields named r1.
    
    Test Plan: validate, new test cases
    
    Reviewers: austin
    
    Subscribers: simonmar, relrod, carter
    
    Differential Revision: https://phabricator.haskell.org/D87
    
    GHC Trac: #9156


>---------------------------------------------------------------

7372bce33716d83caf1f666e8225768561bdaf16
 compiler/hsSyn/HsUtils.lhs                     | 34 ++++++++++++--------------
 testsuite/tests/rename/should_compile/rn068.hs |  4 ++-
 2 files changed, 19 insertions(+), 19 deletions(-)

diff --git a/compiler/hsSyn/HsUtils.lhs b/compiler/hsSyn/HsUtils.lhs
index 4cfdfd0..38d340c 100644
--- a/compiler/hsSyn/HsUtils.lhs
+++ b/compiler/hsSyn/HsUtils.lhs
@@ -100,7 +100,10 @@ import FastString
 import Util
 import Bag
 import Outputable
+
 import Data.Either
+import Data.Function
+import Data.List
 \end{code}
 
 
@@ -747,26 +750,21 @@ hsConDeclsBinders :: (Eq name) => [LConDecl name] -> [Located name]
   -- See hsLTyClDeclBinders for what this does
   -- The function is boringly complicated because of the records
   -- And since we only have equality, we have to be a little careful
-hsConDeclsBinders cons
-  = snd (foldl do_one ([], []) cons)
-  where
-    do_one (flds_seen, acc) (L loc (ConDecl { con_name = L _ name
-                                            , con_details = RecCon flds }))
-	= (map unLoc new_flds ++ flds_seen, L loc name : new_flds ++ acc)
-	where
+hsConDeclsBinders cons = go id cons
+  where go _ [] = []
+        go remSeen (r:rs) =
           -- don't re-mangle the location of field names, because we don't
           -- have a record of the full location of the field declaration anyway
-	  new_flds = remove_seen (map cd_fld_name flds) []
-	  -- remove only the first occurrence of any seen field in order to
-	  -- avoid circumventing detection of duplicate fields (#9156)
-	  remove_seen [] _ = []
-	  remove_seen (x:xs) flds_used =
-		if unLoc x `elem` flds_seen && not (unLoc x `elem` flds_used)
-                  then remove_seen xs (unLoc x : flds_used)
-                  else x : remove_seen xs flds_used
-
-    do_one (flds_seen, acc) (L loc (ConDecl { con_name = L _ name }))
-	= (flds_seen, L loc name : acc)
+          case r of
+             -- remove only the first occurrence of any seen field in order to
+             -- avoid circumventing detection of duplicate fields (#9156)
+             L loc (ConDecl { con_name = L _ name , con_details = RecCon flds }) ->
+               (L loc name) : r' ++ go remSeen' rs
+                  where r' = remSeen (map cd_fld_name flds)
+                        remSeen' = foldr (.) remSeen [deleteBy ((==) `on` unLoc) v | v <- r']
+             L loc (ConDecl { con_name = L _ name }) ->
+                (L loc name) : go remSeen rs
+
 \end{code}
 
 Note [Binders in family instances]
diff --git a/testsuite/tests/rename/should_compile/rn068.hs b/testsuite/tests/rename/should_compile/rn068.hs
index ec520e2..83ed851 100644
--- a/testsuite/tests/rename/should_compile/rn068.hs
+++ b/testsuite/tests/rename/should_compile/rn068.hs
@@ -1,3 +1,5 @@
 module Foo where
 
-data A = A1 { a, b :: Int } | A2 { a, b :: Int }
+data A = A1 { a, b :: Int }
+       | A2 { a, b :: Int }
+       | A3 { a, b :: Int }