diff options
author | Andreas Klebinger <klebinger.andreas@gmx.at> | 2022-05-09 16:09:39 +0200 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2022-05-24 22:13:19 -0400 |
commit | 7c51177d3e135cbba4bc170126c74825fd7bdd61 (patch) | |
tree | 8d11c8bd0e91a1fe0c6f377157a1e6ba2662d410 | |
parent | f485d26738c83ef564794b41188e0e082ee59b26 (diff) | |
download | haskell-7c51177d3e135cbba4bc170126c74825fd7bdd61.tar.gz |
Use UnionListsOrd instead of UnionLists in most places.
This should get rid of most, if not all "Overlong lists" errors and fix #20016
-rw-r--r-- | compiler/GHC/Data/List/SetOps.hs | 17 | ||||
-rw-r--r-- | compiler/GHC/Tc/Types.hs | 6 | ||||
-rw-r--r-- | compiler/GHC/Types/Avail.hs | 11 |
3 files changed, 25 insertions, 9 deletions
diff --git a/compiler/GHC/Data/List/SetOps.hs b/compiler/GHC/Data/List/SetOps.hs index 187d862b3d..dff41991da 100644 --- a/compiler/GHC/Data/List/SetOps.hs +++ b/compiler/GHC/Data/List/SetOps.hs @@ -12,7 +12,7 @@ -- -- Avoid using them as much as possible module GHC.Data.List.SetOps ( - unionLists, minusList, + unionLists, unionListsOrd, minusList, -- Association lists Assoc, assoc, assocMaybe, assocUsing, assocDefault, assocDefaultUsing, @@ -54,6 +54,19 @@ getNth xs n = assertPpr (xs `lengthExceeds` n) (ppr n $$ ppr xs) $ -} + +-- | Combines the two lists while keeping their order, placing the first argument +-- first in the result. +-- +-- Uses a set internally to record duplicates. This makes it slightly slower for +-- very small lists but avoids quadratic behaviour for large lists. +unionListsOrd :: (HasDebugCallStack, Outputable a, Ord a) => [a] -> [a] -> [a] +unionListsOrd xs ys + -- Since both arguments don't have internal duplicates we can just take all of xs + -- and every element of ys that's not already in xs. + = let set_ys = S.fromList ys + in (filter (\e -> not $ S.member e set_ys) xs) ++ ys + -- | Assumes that the arguments contain no duplicates unionLists :: (HasDebugCallStack, Outputable a, Eq a) => [a] -> [a] -> [a] -- We special case some reasonable common patterns. @@ -161,7 +174,7 @@ equivClasses cmp items = NE.groupBy eq (L.sortBy cmp items) eq a b = case cmp a b of { EQ -> True; _ -> False } -- | Remove the duplicates from a list using the provided --- comparison function. +-- comparison function. Might change the order of elements. -- -- Returns the list without duplicates, and accumulates -- all the duplicates in the second component of its result. diff --git a/compiler/GHC/Tc/Types.hs b/compiler/GHC/Tc/Types.hs index c56cbc1322..56c2b1b8a4 100644 --- a/compiler/GHC/Tc/Types.hs +++ b/compiler/GHC/Tc/Types.hs @@ -1412,9 +1412,9 @@ plusImportAvails imp_trust_pkgs = tpkgs1 `S.union` tpkgs2, imp_trust_own_pkg = tself1 || tself2, imp_boot_mods = srs1 `plusModDeps` srcs2, - imp_sig_mods = sig_mods1 `unionLists` sig_mods2, - imp_orphs = orphs1 `unionLists` orphs2, - imp_finsts = finsts1 `unionLists` finsts2 } + imp_sig_mods = unionListsOrd sig_mods1 sig_mods2, + imp_orphs = unionListsOrd orphs1 orphs2, + imp_finsts = unionListsOrd finsts1 finsts2 } {- ************************************************************************ diff --git a/compiler/GHC/Types/Avail.hs b/compiler/GHC/Types/Avail.hs index 487802687f..90e3d1a0c9 100644 --- a/compiler/GHC/Types/Avail.hs +++ b/compiler/GHC/Types/Avail.hs @@ -276,6 +276,9 @@ instance HasOccName GreName where occName (NormalGreName n) = occName n occName (FieldGreName fl) = occName fl +instance Ord GreName where + compare = stableGreNameCmp + -- | A 'Name' for internal use, but not for output to the user. For fields, the -- 'OccName' will be the selector. See Note [GreNames] in GHC.Types.Name.Reader. greNameMangledName :: GreName -> Name @@ -315,10 +318,10 @@ plusAvail (AvailTC _ []) a2@(AvailTC {}) = a2 plusAvail a1@(AvailTC {}) (AvailTC _ []) = a1 plusAvail (AvailTC n1 (s1:ss1)) (AvailTC n2 (s2:ss2)) = case (NormalGreName n1==s1, NormalGreName n2==s2) of -- Maintain invariant the parent is first - (True,True) -> AvailTC n1 (s1 : (ss1 `unionLists` ss2)) - (True,False) -> AvailTC n1 (s1 : (ss1 `unionLists` (s2:ss2))) - (False,True) -> AvailTC n1 (s2 : ((s1:ss1) `unionLists` ss2)) - (False,False) -> AvailTC n1 ((s1:ss1) `unionLists` (s2:ss2)) + (True,True) -> AvailTC n1 (s1 : (ss1 `unionListsOrd` ss2)) + (True,False) -> AvailTC n1 (s1 : (ss1 `unionListsOrd` (s2:ss2))) + (False,True) -> AvailTC n1 (s2 : ((s1:ss1) `unionListsOrd` ss2)) + (False,False) -> AvailTC n1 ((s1:ss1) `unionListsOrd` (s2:ss2)) plusAvail a1 a2 = pprPanic "GHC.Rename.Env.plusAvail" (hsep [ppr a1,ppr a2]) -- | trims an 'AvailInfo' to keep only a single name |