[Git][ghc/ghc][master] hi: Stable sort avails

[Marge Bot (@marge-bot)]

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


Commits:
cf47b96f by Rodrigo Mesquita at 2024-08-03T05:59:40-04:00
hi: Stable sort avails

Sorting the Avails in DocStructures is required to produce fully
deterministic interface files in presence of re-exported modules.

Fixes #25104

- - - - -


5 changed files:

- compiler/GHC/Hs/Doc.hs
- compiler/GHC/HsToCore/Docs.hs
- compiler/GHC/Iface/Make.hs
- compiler/GHC/Types/Avail.hs
- testsuite/tests/showIface/HaddockIssue849.stdout


Changes:

=====================================
compiler/GHC/Hs/Doc.hs
=====================================
@@ -133,7 +133,12 @@ data DocStructureItem
                             -- > module M (module X) where
                             -- > import R0 as X
                             -- > import R1 as X
+                            --
+                            -- Invariant: This list of ModuleNames must be
+                            -- sorted to guarantee interface file determinism.
       !Avails
+                            -- ^ Invariant: This list of Avails must be sorted
+                            -- to guarantee interface file determinism.
 
 instance Binary DocStructureItem where
   put_ bh = \case


=====================================
compiler/GHC/HsToCore/Docs.hs
=====================================
@@ -147,7 +147,6 @@ mkDocStructure _ _ Nothing rn_decls all_exports def_meths_env =
 -- TODO:
 -- * Maybe remove items that export nothing?
 -- * Combine sequences of DsiExports?
--- * Check the ordering of avails in DsiModExport
 mkDocStructureFromExportList
   :: Module                         -- ^ The current module
   -> ImportAvails
@@ -168,7 +167,7 @@ mkDocStructureFromExportList mdl import_avails export_list =
                  -> Avails
                  -> DocStructureItem
     moduleExport alias avails =
-        DsiModExport (nubSortNE orig_names) (nubAvails avails)
+        DsiModExport (nubSortNE orig_names) (sortAvails (nubAvails avails))
       where
         orig_names = M.findWithDefault aliasErr alias aliasMap
         aliasErr = error $ "mkDocStructureFromExportList: "


=====================================
compiler/GHC/Iface/Make.hs
=====================================
@@ -500,18 +500,7 @@ mkIfaceImports = map go
     go (ImpUserSpec decl (ImpUserEverythingBut ns)) = IfaceImport decl (ImpIfaceEverythingBut ns)
 
 mkIfaceExports :: [AvailInfo] -> [IfaceExport]  -- Sort to make canonical
-mkIfaceExports exports
-  = sortBy stableAvailCmp (map sort_subs exports)
-  where
-    sort_subs :: AvailInfo -> AvailInfo
-    sort_subs (Avail n) = Avail n
-    sort_subs (AvailTC n []) = AvailTC n []
-    sort_subs (AvailTC n (m:ms))
-       | n == m
-       = AvailTC n (m:sortBy stableNameCmp ms)
-       | otherwise
-       = AvailTC n (sortBy stableNameCmp (m:ms))
-       -- Maintain the AvailTC Invariant
+mkIfaceExports = sortAvails
 
 {-
 Note [Original module]


=====================================
compiler/GHC/Types/Avail.hs
=====================================
@@ -19,6 +19,7 @@ module GHC.Types.Avail (
     filterAvail,
     filterAvails,
     nubAvails,
+    sortAvails,
   ) where
 
 import GHC.Prelude
@@ -36,7 +37,7 @@ import GHC.Utils.Constants (debugIsOn)
 import Control.DeepSeq
 import Data.Data ( Data )
 import Data.Functor.Classes ( liftCompare )
-import Data.List ( find )
+import Data.List ( find, sortBy )
 import qualified Data.Semigroup as S
 
 -- -----------------------------------------------------------------------------
@@ -131,6 +132,20 @@ availSubordinateNames avail@(AvailTC _ ns)
   | availExportsDecl avail = tail ns
   | otherwise              = ns
 
+-- | Sort 'Avails'/'AvailInfo's
+sortAvails :: Avails -> Avails
+sortAvails = sortBy stableAvailCmp . map sort_subs
+  where
+    sort_subs :: AvailInfo -> AvailInfo
+    sort_subs (Avail n) = Avail n
+    sort_subs (AvailTC n []) = AvailTC n []
+    sort_subs (AvailTC n (m:ms))
+       | n == m
+       = AvailTC n (m:sortBy stableNameCmp ms)
+       | otherwise
+       = AvailTC n (sortBy stableNameCmp (m:ms))
+       -- Maintain the AvailTC Invariant
+
 -- -----------------------------------------------------------------------------
 -- Utility
 


=====================================
testsuite/tests/showIface/HaddockIssue849.stdout
=====================================
@@ -11,12 +11,12 @@ docs:
          re-exported module(s): [Data.Functor.Identity]
            []
          re-exported module(s): [Data.Maybe]
-           [GHC.Internal.Maybe.Maybe{GHC.Internal.Maybe.Maybe,
-                                     GHC.Internal.Maybe.Nothing, GHC.Internal.Maybe.Just},
-            GHC.Internal.Data.Maybe.maybe]
+           [GHC.Internal.Data.Maybe.maybe,
+            GHC.Internal.Maybe.Maybe{GHC.Internal.Maybe.Maybe,
+                                     GHC.Internal.Maybe.Just, GHC.Internal.Maybe.Nothing}]
          re-exported module(s): [Data.Tuple]
-           [GHC.Internal.Data.Tuple.swap, GHC.Internal.Data.Tuple.curry,
-            GHC.Internal.Data.Tuple.fst, GHC.Internal.Data.Tuple.snd,
+           [GHC.Internal.Data.Tuple.curry, GHC.Internal.Data.Tuple.fst,
+            GHC.Internal.Data.Tuple.snd, GHC.Internal.Data.Tuple.swap,
             GHC.Internal.Data.Tuple.uncurry]
        named chunks:
        haddock options:



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cf47b96f8b8100d9f9ad1b8121cbfb65fd7eaf2a
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/20240803/f1226a15/attachment-0001.html>