[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: hi: Stable sort avails

Marge Bot (@marge-bot) gitlab at gitlab.haskell.org
Mon Aug 5 15:52:27 UTC 2024



Marge Bot pushed to branch wip/marge_bot_batch_merge_job 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

- - - - -
af2ae742 by M. Taimoor Zaeem at 2024-08-03T18:52:50+05:00
haddock: decrease margin on top of small headings

- - - - -
eab6f398 by Rodrigo Mesquita at 2024-08-05T11:52:16-04:00
hi: Deterministic ImportedMods in Usages

The `mi_usages` field of the interface files must use a deterministic
list of `Usage`s to guarantee a deterministic interface. However, this
list was, in its origins, constructed from a `ModuleEnv` which uses a
non-deterministic ordering that was leaking into the interface.

Specifically, ImportedMods = ModuleEnv ... would get converted to a list and
then passed to `mkUsageInfo` to construct the Usages.

The solution is simple. Back `ImportedMods` with a deterministic map.
`Map Module ...` is enough, since the Ord instance for `Module` already
uses a stable, deterministic, comparison.

Fixes #25131

- - - - -


17 changed files:

- compiler/GHC/Driver/Main.hs
- compiler/GHC/Hs/Doc.hs
- compiler/GHC/HsToCore/Docs.hs
- compiler/GHC/HsToCore/Usage.hs
- compiler/GHC/Iface/Make.hs
- compiler/GHC/Rename/Names.hs
- compiler/GHC/Rename/Unbound.hs
- compiler/GHC/Tc/Gen/Export.hs
- compiler/GHC/Tc/Gen/Splice.hs
- compiler/GHC/Tc/Module.hs
- compiler/GHC/Tc/Types.hs
- compiler/GHC/Types/Avail.hs
- compiler/GHC/Unit/Module/Imported.hs
- compiler/GHC/Unit/Module/ModIface.hs
- testsuite/tests/showIface/HaddockIssue849.stdout
- utils/haddock/CHANGES.md
- utils/haddock/haddock-api/resources/html/Linuwial.std-theme/linuwial.css


Changes:

=====================================
compiler/GHC/Driver/Main.hs
=====================================
@@ -1489,7 +1489,7 @@ checkSafeImports tcg_env
   where
     impInfo  = tcg_imports tcg_env     -- ImportAvails
     imports  = imp_mods impInfo        -- ImportedMods
-    imports1 = moduleEnvToList imports -- (Module, [ImportedBy])
+    imports1 = M.toList imports -- (Module, [ImportedBy])
     imports' = map (fmap importedByUser) imports1 -- (Module, [ImportedModsVal])
     pkgReqs  = imp_trust_pkgs impInfo  -- [Unit]
 


=====================================
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
=====================================
@@ -34,7 +34,6 @@ import GHC.IORef (readIORef)
 import GHC.Unit.Types
 import GHC.Hs
 import GHC.Types.Avail
-import GHC.Unit.Module
 import qualified Data.List.NonEmpty as NonEmpty
 import Data.List.NonEmpty (NonEmpty ((:|)))
 import GHC.Unit.Module.Imported
@@ -147,7 +146,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 +166,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: "
@@ -184,13 +182,12 @@ mkDocStructureFromExportList mdl import_avails export_list =
     aliasMap =
         M.fromListWith (<>) $
           (this_mdl_name, this_mdl_name :| [])
-          : (flip concatMap (moduleEnvToList imported) $ \(mdl, imvs) ->
+          : (flip concatMap (M.toList imported) $ \(mdl, imvs) ->
               [(imv_name imv, moduleName mdl :| []) | imv <- imvs])
       where
         this_mdl_name = moduleName mdl
 
-    imported :: ModuleEnv [ImportedModsVal]
-    imported = mapModuleEnv importedByUser (imp_mods import_avails)
+    imported = M.map importedByUser (imp_mods import_avails)
 
 -- | Figure out the documentation structure by correlating
 -- the module exports with the located declarations.


=====================================
compiler/GHC/HsToCore/Usage.hs
=====================================
@@ -208,7 +208,7 @@ mk_mod_usage_info uc home_unit home_unit_ids this_mod direct_imports used_names
     safe_implicit_imps_req = uc_safe_implicit_imps_req uc
 
     used_mods    = moduleEnvKeys ent_map
-    dir_imp_mods = moduleEnvKeys direct_imports
+    dir_imp_mods = Map.keys direct_imports
     all_mods     = used_mods ++ filter (`notElem` used_mods) dir_imp_mods
     usage_mods   = sortBy stableModuleCmp all_mods
                         -- canonical order is imported, to avoid interface-file
@@ -289,7 +289,7 @@ mk_mod_usage_info uc home_unit home_unit_ids this_mod direct_imports used_names
         by_is_safe (ImportedByUser imv) = imv_is_safe imv
         by_is_safe _ = False
         (is_direct_import, imp_safe)
-            = case lookupModuleEnv direct_imports mod of
+            = case Map.lookup mod direct_imports of
                 -- ezyang: I'm not sure if any is the correct
                 -- metric here. If safety was guaranteed to be uniform
                 -- across all imports, why did the old code only look


=====================================
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/Rename/Names.hs
=====================================
@@ -573,7 +573,7 @@ calculateAvails home_unit other_home_units iface mod_safe' want_boot imported_by
 
 
   in ImportAvails {
-          imp_mods       = unitModuleEnv (mi_module iface) [imported_by],
+          imp_mods       = Map.singleton (mi_module iface) [imported_by],
           imp_orphs      = orphans,
           imp_finsts     = finsts,
           imp_sig_mods   = sig_mods,


=====================================
compiler/GHC/Rename/Unbound.hs
=====================================
@@ -66,6 +66,7 @@ import Data.List (sortBy, partition, nub)
 import Data.List.NonEmpty ( pattern (:|), NonEmpty )
 import Data.Function ( on )
 import qualified Data.Semigroup as S
+import qualified Data.Map as M
 
 {-
 ************************************************************************
@@ -339,7 +340,7 @@ importSuggestions looking_for global_env hpt currMod imports rdr_name
   -- What import statements provide "Mod" at all
   -- or, if this is an unqualified name, are not qualified imports
   interesting_imports = [ (mod, imp)
-    | (mod, mod_imports) <- moduleEnvToList (imp_mods imports)
+    | (mod, mod_imports) <- M.toList (imp_mods imports)
     , Just imp <- return $ pick (importedByUser mod_imports)
     ]
 


=====================================
compiler/GHC/Tc/Gen/Export.hs
=====================================
@@ -52,6 +52,7 @@ import Control.Monad ( when )
 import qualified Data.List.NonEmpty as NE
 import Data.Traversable   ( for )
 import Data.List ( sortBy )
+import qualified Data.Map as Map
 
 {-
 ************************************************************************
@@ -307,7 +308,7 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
       = [gre]
 
     imported_modules = [ imv_name imv
-                       | xs <- moduleEnvElts $ imp_mods imports
+                       | xs <- Map.elems $ imp_mods imports
                        , imv <- importedByUser xs ]
 
     exports_from_item :: ExportAccum -> LIE GhcPs


=====================================
compiler/GHC/Tc/Gen/Splice.hs
=====================================
@@ -2886,7 +2886,7 @@ reifyModule (TH.Module (TH.PkgName pkgString) (TH.ModName mString)) = do
   if (reifMod == this_mod) then reifyThisModule else reifyFromIface reifMod
     where
       reifyThisModule = do
-        usages <- fmap (map modToTHMod . moduleEnvKeys . imp_mods) getImports
+        usages <- fmap (map modToTHMod . Map.keys . imp_mods) getImports
         return $ TH.ModuleInfo usages
 
       reifyFromIface reifMod = do


=====================================
compiler/GHC/Tc/Module.hs
=====================================
@@ -178,6 +178,7 @@ import Data.List.NonEmpty ( NonEmpty (..) )
 import qualified Data.List.NonEmpty as NE
 import Data.Ord
 import qualified Data.Set as S
+import qualified Data.Map as M
 import Data.Foldable ( for_ )
 import Data.Traversable ( for )
 
@@ -432,7 +433,7 @@ tcRnImports hsc_env import_decls
                 -- Check type-family consistency between imports.
                 -- See Note [The type family instance consistency story]
         ; traceRn "rn1: checking family instance consistency {" empty
-        ; let { dir_imp_mods = moduleEnvKeys
+        ; let { dir_imp_mods = M.keys
                              . imp_mods
                              $ imports }
         ; checkFamInstConsistency dir_imp_mods


=====================================
compiler/GHC/Tc/Types.hs
=====================================
@@ -176,6 +176,7 @@ import GHCi.RemoteTypes
 
 import Data.Set      ( Set )
 import qualified Data.Set as S
+import qualified Data.Map as M
 import Data.Dynamic  ( Dynamic )
 import Data.Map ( Map )
 import Data.Typeable ( TypeRep )
@@ -916,7 +917,7 @@ plusModDeps = plusInstalledModuleEnv plus_mod_dep
       -- perf/compiler/MultiLayerModules
 
 emptyImportAvails :: ImportAvails
-emptyImportAvails = ImportAvails { imp_mods          = emptyModuleEnv,
+emptyImportAvails = ImportAvails { imp_mods          = M.empty,
                                    imp_direct_dep_mods = emptyInstalledModuleEnv,
                                    imp_dep_direct_pkgs = S.empty,
                                    imp_sig_mods      = [],
@@ -947,7 +948,7 @@ plusImportAvails
                   imp_sig_mods = sig_mods2,
                   imp_trust_pkgs = tpkgs2, imp_trust_own_pkg = tself2,
                   imp_orphs = orphs2, imp_finsts = finsts2 })
-  = ImportAvails { imp_mods          = plusModuleEnv_C (++) mods1 mods2,
+  = ImportAvails { imp_mods          = M.unionWith (++) mods1 mods2,
                    imp_direct_dep_mods = ddmods1 `plusModDeps` ddmods2,
                    imp_dep_direct_pkgs      = ddpkgs1 `S.union` ddpkgs2,
                    imp_trust_pkgs    = tpkgs1 `S.union` tpkgs2,


=====================================
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
 


=====================================
compiler/GHC/Unit/Module/Imported.hs
=====================================
@@ -13,10 +13,13 @@ import GHC.Unit.Module
 import GHC.Types.Name.Reader
 import GHC.Types.SafeHaskell
 import GHC.Types.SrcLoc
+import Data.Map (Map)
 
 -- | Records the modules directly imported by a module for extracting e.g.
 -- usage information, and also to give better error message
-type ImportedMods = ModuleEnv [ImportedBy]
+type ImportedMods = Map Module [ImportedBy]
+  -- We don't want to use a `ModuleEnv` since it would leak a non-deterministic
+  -- order to the interface files when passed as a list to `mkUsageInfo`.
 
 -- | If a module was "imported" by the user, we associate it with
 -- more detailed usage information 'ImportedModsVal'; a module


=====================================
compiler/GHC/Unit/Module/ModIface.hs
=====================================
@@ -245,6 +245,9 @@ data ModIface_ (phase :: ModIfacePhase)
                 -- doesn't affect the hash of this module)
                 -- NOT STRICT!  we read this field lazily from the interface file
                 -- It is *only* consulted by the recompilation checker
+                --
+                -- The elements must be *deterministically* sorted to guarantee
+                -- deterministic interface files
 
         mi_exports_  :: ![IfaceExport],
                 -- ^ Exports


=====================================
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:


=====================================
utils/haddock/CHANGES.md
=====================================
@@ -3,6 +3,8 @@
 
  * Add incremental mode to support rendering documentation one module at a time.
 
+ * Fix large margin on top of small headings
+
 ## Changes in 2.28.0
  * `hi-haddock` is integrated, which means docstrings are no longer extracted
    through typchecked module results. Instead, docstrings are taken from Haskell


=====================================
utils/haddock/haddock-api/resources/html/Linuwial.std-theme/linuwial.css
=====================================
@@ -295,10 +295,14 @@ pre, code, kbd, samp, tt, .src {
 }
 
 
-* + h1, * + h2, * + h3, * + h4, * + h5, * + h6 {
+* + h1, * + h2, * + h3 {
   margin-top: 2em;
 }
 
+* + h4 , * + h5, * + h6 {
+  margin-top: 1em;
+}
+
 h1 + h2, h2 + h3, h3 + h4, h4 + h5, h5 + h6 {
   margin-top: inherit;
 }



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6516c571d54117ecfa714dfbc48fc1b5d62b979a...eab6f39844830d435a31b1c6faff217563c7a29f

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6516c571d54117ecfa714dfbc48fc1b5d62b979a...eab6f39844830d435a31b1c6faff217563c7a29f
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/20240805/441cd422/attachment-0001.html>


More information about the ghc-commits mailing list