[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: hi: Deterministic ImportedMods in Usages
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Tue Aug 6 02:34:48 UTC 2024
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
a1e42e7a by Rodrigo Mesquita at 2024-08-05T21:03:04-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
- - - - -
7eccbd73 by Andreas Klebinger at 2024-08-05T22:34:37-04:00
Add since annotation for -fkeep-auto-rules.
This partially addresses #25082.
- - - - -
d486c470 by Andreas Klebinger at 2024-08-05T22:34:37-04:00
Mention `-fkeep-auto-rules` in release notes.
It was added earlier but hadn't appeared in any release notes yet.
Partially addresses #25082.
- - - - -
3ad1b70d by Vladislav Zavialov at 2024-08-05T22:34:38-04:00
docs: Update info on RequiredTypeArguments
Add a section on "types in terms" that were implemented in 8b2f70a202
and remove the now outdated suggestion of using `type` for them.
- - - - -
14 changed files:
- compiler/GHC/Driver/Main.hs
- compiler/GHC/HsToCore/Docs.hs
- compiler/GHC/HsToCore/Usage.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/Unit/Module/Imported.hs
- compiler/GHC/Unit/Module/ModIface.hs
- docs/users_guide/9.12.1-notes.rst
- docs/users_guide/exts/required_type_arguments.rst
- docs/users_guide/using-optimisation.rst
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/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
@@ -183,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/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/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
=====================================
docs/users_guide/9.12.1-notes.rst
=====================================
@@ -109,6 +109,10 @@ Compiler
This enables people to write their own custom assertion functions.
See :ref:`assertions`.
+- The flag :ghc-flag:`-fkeep-auto-rules` that forces GHC to keep auto generated
+ specialization rules was added. It was actually added ghc-9.10.1 already but
+ mistakenly not mentioned in the 9.10.1 changelog.
+
- Fixed a bug that caused GHC to panic when using the aarch64 ncg and -fregs-graph
on certain programs. (#24941)
=====================================
docs/users_guide/exts/required_type_arguments.rst
=====================================
@@ -262,15 +262,36 @@ Outside a required type argument, it is illegal to use ``type``:
r4 = type Int -- illegal use of ‘type’
-Finally, there are types that require the ``type`` keyword only due to
-limitations of the current implementation::
+Types in terms
+~~~~~~~~~~~~~~
- a1 = f (type (Int -> Bool)) -- function type
- a2 = f (type (Read T => T)) -- constrained type
- a3 = f (type (forall a. a)) -- universally quantified type
- a4 = f (type (forall a. Read a => String -> a)) -- a combination of the above
+**Since:** GHC 9.12
-This restriction will be relaxed in a future release of GHC.
+:extension:`RequiredTypeArguments` extends the grammar of term-level
+expressions with syntax that is typically found only in types:
+
+* function types: ``a -> b``, ``a ⊸ b``, ``a %m -> b``
+* constrained types: ``ctx => t``
+* universally quantified types: ``forall tvs. t``, ``forall tvs -> t``
+
+These so-called "types in terms" make it possible to pass any types as required
+type arguments::
+
+ a1 = f (Int -> Bool) -- function type
+ a2 = f (Int %1 -> String) -- linear function type
+ a3 = f (Read T => T) -- constrained type
+ a4 = f (forall a. a) -- universally quantified type
+ a5 = f (forall a. Read a => String -> a) -- a combination of the above
+
+A few limitations apply:
+
+* The ``*`` syntax of :extension:`StarIsType` is not available due to a
+ conflict with the multiplication operator.
+ What to do instead: use ``Type`` from the ``Data.Kind`` module.
+
+* The ``'`` syntax of :extension:`DataKinds` is not available due to a conflict
+ with :extension:`TemplateHaskell` name quotation.
+ What to do instead: simply omit the ``'``.
Effect on implicit quantification
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
=====================================
docs/users_guide/using-optimisation.rst
=====================================
@@ -664,10 +664,11 @@ as such you shouldn't need to set any of them explicitly. A flag
:category:
:default: off
+ :since: 9.10.1
The type-class specialiser and call-pattern specialisation both
generate so-called "auto" RULES. These rules are usually exposed
- to importing modules in the interface file. But an auto rule is the
+ to importing modules in the interface file. But when an auto rule is the
sole reason for keeping a function alive, both the rule and the function
are discarded, by default. That reduces code bloat, but risks the same
function being specialised again in an importing module.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/eab6f39844830d435a31b1c6faff217563c7a29f...3ad1b70d1c4dad7a3e0c5e623fed728ee54b7546
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/eab6f39844830d435a31b1c6faff217563c7a29f...3ad1b70d1c4dad7a3e0c5e623fed728ee54b7546
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/e7edd39c/attachment-0001.html>
More information about the ghc-commits
mailing list