diff options
| author | Krzysztof Gogolewski <krzysztof.gogolewski@tweag.io> | 2023-01-16 17:33:22 +0100 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2023-01-24 05:38:32 -0500 |
| commit | 34d2d4635ee2f7eb878b4dacb68fa7b066dd16e0 (patch) | |
| tree | d86b84d994445271f5ff7091021e8ad6bf97d32e | |
| parent | be701cc64f0ff78aa50bcd7293d8692dc1ba6c85 (diff) | |
| download | haskell-34d2d4635ee2f7eb878b4dacb68fa7b066dd16e0.tar.gz | |
Fix Lint check for duplicate external names
Lint was checking for duplicate external names by calling removeDups,
which needs a comparison function that is passed to Data.List.sortBy.
But the comparison was not a valid ordering - it returned LT
if one of the names was not external.
For example, the previous implementation won't find a duplicate in
[M.x, y, M.x].
Instead, we filter out non-external names before looking for duplicates.
| -rw-r--r-- | compiler/GHC/Core/Lint.hs | 11 |
1 files changed, 5 insertions, 6 deletions
diff --git a/compiler/GHC/Core/Lint.hs b/compiler/GHC/Core/Lint.hs index 73faebd80d..45561d784c 100644 --- a/compiler/GHC/Core/Lint.hs +++ b/compiler/GHC/Core/Lint.hs @@ -96,6 +96,7 @@ import Data.Foldable ( for_, toList ) import Data.List.NonEmpty ( NonEmpty(..), groupWith ) import Data.List ( partition ) import Data.Maybe +import Data.Ord ( comparing ) import GHC.Data.Pair import GHC.Base (oneShot) import GHC.Data.Unboxed @@ -471,17 +472,15 @@ lintCoreBindings' cfg binds (_, dups) = removeDups compare binders - -- dups_ext checks for names with different uniques + -- ext_dups checks for names with different uniques -- but the same External name M.n. We don't -- allow this at top level: -- M.n{r3} = ... -- M.n{r29} = ... -- because they both get the same linker symbol - ext_dups = snd (removeDups ord_ext (map Var.varName binders)) - ord_ext n1 n2 | Just m1 <- nameModule_maybe n1 - , Just m2 <- nameModule_maybe n2 - = compare (m1, nameOccName n1) (m2, nameOccName n2) - | otherwise = LT + ext_dups = snd $ removeDups (comparing ord_ext) $ + filter isExternalName $ map Var.varName binders + ord_ext n = (nameModule n, nameOccName n) {- ************************************************************************ |