[Git][ghc/ghc][master] Fix Lint check for duplicate external names

[Marge Bot (@marge-bot)]

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
34d2d463 by Krzysztof Gogolewski at 2023-01-24T05:38:32-05:00
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.

- - - - -


1 changed file:

- compiler/GHC/Core/Lint.hs


Changes:

=====================================
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)
 
 {-
 ************************************************************************



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/34d2d4635ee2f7eb878b4dacb68fa7b066dd16e0

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/34d2d4635ee2f7eb878b4dacb68fa7b066dd16e0
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230124/d8efb870/attachment-0001.html>