diff options
author | Gintautas Miliauskas <gintautas.miliauskas@gmail.com> | 2014-06-07 15:38:56 +0000 |
---|---|---|
committer | Joachim Breitner <mail@joachim-breitner.de> | 2014-07-22 12:38:53 +0200 |
commit | 98a6e277d100021580a4a7ee75fe2d30572e03db (patch) | |
tree | 0a861f5ad98211cf2f6a60ba82f73b358cbe473d | |
parent | 360a6be2b986bb6ffae67aaa5ca6d87d0e19a93e (diff) | |
download | haskell-98a6e277d100021580a4a7ee75fe2d30572e03db.tar.gz |
Refactored record field duplicate code to use nested filtering functions instead of manually walking accumulator lists.
-rw-r--r-- | compiler/hsSyn/HsUtils.lhs | 34 | ||||
-rw-r--r-- | 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 4cfdfd04f6..38d340c359 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 ec520e25b9..83ed851ed8 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 } |