Cheng Shao pushed to branch wip/hiddenmodules-uniqset at Glasgow Haskell Compiler / GHC
Commits:
fbf8d52b by Cheng Shao at 2025-08-16T19:39:35+02:00
driver: use UniqSet for hiddenModules in DynFlags/FinderOpts
This patch replaces Set ModuleName with UniqSet ModuleName in
DynFlags.hiddenModules and FinderOpts.finder_hiddenModules for
improved efficiency.
Co-authored-by: Codex
- - - - -
96513732 by Cheng Shao at 2025-08-16T19:42:26+02:00
driver: use UniqMap ModuleName in the finder
This patch replaces Map ModuleName with UniqMap ModuleName in the
finder for improved efficiency.
Co-authored-by: Codex
- - - - -
7 changed files:
- compiler/GHC/Driver/Config/Finder.hs
- compiler/GHC/Driver/DynFlags.hs
- compiler/GHC/Driver/Make.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/HsToCore/Docs.hs
- compiler/GHC/Unit/Finder.hs
- compiler/GHC/Unit/Finder/Types.hs
Changes:
=====================================
compiler/GHC/Driver/Config/Finder.hs
=====================================
@@ -9,7 +9,7 @@ import GHC.Driver.DynFlags
import GHC.Unit.Finder.Types
import GHC.Data.FastString
import GHC.Data.OsPath
-import qualified Data.Map as Map
+import GHC.Types.Unique.Map
-- | Create a new 'FinderOpts' from DynFlags.
initFinderOpts :: DynFlags -> FinderOpts
@@ -22,7 +22,7 @@ initFinderOpts flags = FinderOpts
, finder_workingDirectory = fmap unsafeEncodeUtf $ workingDirectory flags
, finder_thisPackageName = mkFastString <$> thisPackageName flags
, finder_hiddenModules = hiddenModules flags
- , finder_reexportedModules = Map.fromList [(known_as, is_as) | ReexportedModule is_as known_as <- reverse (reexportedModules flags)]
+ , finder_reexportedModules = listToUniqMap [(known_as, is_as) | ReexportedModule is_as known_as <- reverse (reexportedModules flags)]
, finder_hieDir = fmap unsafeEncodeUtf $ hieDir flags
, finder_hieSuf = unsafeEncodeUtf $ hieSuf flags
, finder_hiDir = fmap unsafeEncodeUtf $ hiDir flags
=====================================
compiler/GHC/Driver/DynFlags.hs
=====================================
@@ -143,6 +143,7 @@ import System.Directory
import GHC.Foreign (withCString, peekCString)
import qualified Data.Set as Set
+import GHC.Types.Unique.Set
import qualified GHC.LanguageExtensions as LangExt
@@ -261,7 +262,7 @@ data DynFlags = DynFlags {
-- Note [Filepaths and Multiple Home Units]
workingDirectory :: Maybe FilePath,
thisPackageName :: Maybe String, -- ^ What the package is called, use with multiple home units
- hiddenModules :: Set.Set ModuleName,
+ hiddenModules :: !(UniqSet ModuleName),
reexportedModules :: [ReexportedModule],
-- ways
@@ -597,7 +598,7 @@ defaultDynFlags mySettings =
workingDirectory = Nothing,
thisPackageName = Nothing,
- hiddenModules = Set.empty,
+ hiddenModules = emptyUniqSet,
reexportedModules = [],
objectDir = Nothing,
=====================================
compiler/GHC/Driver/Make.hs
=====================================
@@ -109,13 +109,14 @@ import GHC.Unit.Module.ModDetails
import qualified Data.Map as Map
import qualified Data.Set as Set
+import GHC.Types.Unique.Set
import Control.Concurrent.MVar
import Control.Monad
import qualified Control.Monad.Catch as MC
import Data.IORef
import Data.Maybe
-import Data.List (sortOn, groupBy, sortBy)
+import Data.List (sort, sortOn, groupBy, sortBy)
import qualified Data.List as List
import System.FilePath
@@ -313,14 +314,15 @@ warnUnknownModules hsc_env dflags mod_graph = do
where
diag_opts = initDiagOpts dflags
- unit_mods = Set.fromList (map ms_mod_name
+ unit_mods :: UniqSet ModuleName
+ unit_mods = mkUniqSet (map ms_mod_name
(filter (\ms -> ms_unitid ms == homeUnitId_ dflags)
(mgModSummaries mod_graph)))
reexported_mods = reexportedModules dflags
hidden_mods = hiddenModules dflags
- hidden_warns = hidden_mods `Set.difference` unit_mods
+ hidden_warns = hidden_mods `minusUniqSet` unit_mods
lookupModule mn = findImportedModule hsc_env mn NoPkgQual
@@ -337,7 +339,7 @@ warnUnknownModules hsc_env dflags mod_graph = do
final_msgs hidden_warns reexported_warns
=
unionManyMessages $
- [warn (DriverUnknownHiddenModules (homeUnitId_ dflags) (Set.toList hidden_warns)) | not (Set.null hidden_warns)]
+ [warn (DriverUnknownHiddenModules (homeUnitId_ dflags) (sort $ nonDetEltsUniqSet hidden_warns)) | not (isEmptyUniqSet hidden_warns)]
++ [warn (DriverUnknownReexportedModules (homeUnitId_ dflags) reexported_warns) | not (null reexported_warns)]
-- | Describes which modules of the module graph need to be loaded.
=====================================
compiler/GHC/Driver/Session.hs
=====================================
@@ -293,6 +293,7 @@ import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NE
import qualified Data.Map as Map
import qualified Data.Set as Set
+import GHC.Types.Unique.Set
import Data.Word
import System.FilePath
import Text.ParserCombinators.ReadP hiding (char)
@@ -3153,7 +3154,7 @@ setPackageName p d = d { thisPackageName = Just p }
addHiddenModule :: String -> DynP ()
addHiddenModule p =
- upd (\s -> s{ hiddenModules = Set.insert (mkModuleName p) (hiddenModules s) })
+ upd (\s -> s{ hiddenModules = addOneToUniqSet (hiddenModules s) (mkModuleName p) })
addReexportedModule :: String -> DynP ()
addReexportedModule p =
=====================================
compiler/GHC/HsToCore/Docs.hs
=====================================
@@ -175,7 +175,7 @@ mkDocStructureFromExportList mdl import_avails export_list =
moduleExport alias avails =
DsiModExport (nubSortNE orig_names) (sortAvails (nubAvails avails))
where
- orig_names = M.findWithDefault aliasErr alias aliasMap
+ orig_names = fromMaybe aliasErr (lookupUniqMap aliasMap alias)
aliasErr = error $ "mkDocStructureFromExportList: "
++ (moduleNameString . moduleName) mdl
++ ": Can't find alias " ++ moduleNameString alias
@@ -185,9 +185,9 @@ mkDocStructureFromExportList mdl import_avails export_list =
NonEmpty.toList
-- Map from aliases to true module names.
- aliasMap :: Map ModuleName (NonEmpty ModuleName)
+ aliasMap :: UniqMap ModuleName (NonEmpty ModuleName)
aliasMap =
- M.fromListWith (S.<>) $
+ listToUniqMap_C (S.<>) $
(this_mdl_name, this_mdl_name :| [])
: (flip concatMap (M.toList imported) $ \(mdl, imvs) ->
[(imv_name imv, moduleName mdl :| []) | imv <- imvs])
=====================================
compiler/GHC/Unit/Finder.hs
=====================================
@@ -65,9 +65,10 @@ import Control.Applicative ((<|>))
import Control.Monad
import Data.Time
import qualified Data.Map as M
+import GHC.Types.Unique.Map
import GHC.Driver.Env
import GHC.Driver.Config.Finder
-import qualified Data.Set as Set
+import GHC.Types.Unique.Set
import Data.List.NonEmpty ( NonEmpty (..) )
import qualified System.OsPath as OsPath
import qualified Data.List.NonEmpty as NE
@@ -194,9 +195,9 @@ findImportedModuleNoHsc fc fopts ue mhome_unit mod_name mb_pkg =
home_pkg_import (uid, opts)
-- If the module is reexported, then look for it as if it was from the perspective
-- of that package which reexports it.
- | Just real_mod_name <- mod_name `M.lookup` finder_reexportedModules opts =
+ | Just real_mod_name <- lookupUniqMap (finder_reexportedModules opts) mod_name =
findImportedModuleNoHsc fc opts ue (Just $ DefiniteHomeUnit uid Nothing) real_mod_name NoPkgQual
- | mod_name `Set.member` finder_hiddenModules opts =
+ | elementOfUniqSet mod_name (finder_hiddenModules opts) =
return (mkHomeHidden uid)
| otherwise =
findHomePackageModule fc opts uid mod_name
@@ -794,4 +795,3 @@ findObjectLinkable mod obj_fn obj_time =
pure (Linkable obj_time mod (NE.singleton (DotO obj_fn ModuleObject)))
-- We used to look for _stub.o files here, but that was a bug (#706)
-- Now GHC merges the stub.o into the main .o (#3687)
-
=====================================
compiler/GHC/Unit/Finder/Types.hs
=====================================
@@ -12,12 +12,13 @@ import GHC.Prelude
import GHC.Unit
import GHC.Data.OsPath
import qualified Data.Map as M
+import GHC.Types.Unique.Map
import GHC.Fingerprint
import GHC.Platform.Ways
import GHC.Unit.Env
import GHC.Data.FastString
-import qualified Data.Set as Set
+import GHC.Types.Unique.Set
-- | The 'FinderCache' maps modules to the result of
-- searching for that module. It records the results of searching for
@@ -101,8 +102,8 @@ data FinderOpts = FinderOpts
-- that have a similar name.
, finder_workingDirectory :: Maybe OsPath
, finder_thisPackageName :: Maybe FastString
- , finder_hiddenModules :: Set.Set ModuleName
- , finder_reexportedModules :: M.Map ModuleName ModuleName -- Reverse mapping, if you are looking for this name then look for this module.
+ , finder_hiddenModules :: !(UniqSet ModuleName)
+ , finder_reexportedModules :: !(UniqMap ModuleName ModuleName) -- Reverse mapping, if you are looking for this name then look for this module.
, finder_hieDir :: Maybe OsPath
, finder_hieSuf :: OsString
, finder_hiDir :: Maybe OsPath
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b09b64e884f6f3943d803b0e21540fa...
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b09b64e884f6f3943d803b0e21540fa...
You're receiving this email because of your account on gitlab.haskell.org.
