[Git][ghc/ghc][wip/unitidset] Use UniqSet instead of UniqDSet in UnitIdSet

Josh Meredith (@JoshMeredith) gitlab at gitlab.haskell.org
Thu May 25 08:33:01 UTC 2023



Josh Meredith pushed to branch wip/unitidset at Glasgow Haskell Compiler / GHC


Commits:
0e59433f by Josh Meredith at 2023-05-25T08:32:45+00:00
Use UniqSet instead of UniqDSet in UnitIdSet

- - - - -


17 changed files:

- compiler/GHC.hs
- compiler/GHC/Driver/CodeOutput.hs
- compiler/GHC/Driver/Main.hs
- compiler/GHC/Driver/Make.hs
- compiler/GHC/Driver/Pipeline.hs
- compiler/GHC/HsToCore/Usage.hs
- compiler/GHC/Iface/Load.hs
- compiler/GHC/Iface/Recomp.hs
- compiler/GHC/Linker/Loader.hs
- compiler/GHC/Rename/Names.hs
- compiler/GHC/Tc/Module.hs
- compiler/GHC/Tc/Types.hs
- compiler/GHC/Types/Unique/Set.hs
- compiler/GHC/Unit/Env.hs
- compiler/GHC/Unit/Module/Deps.hs
- compiler/GHC/Unit/State.hs
- compiler/GHC/Unit/Types.hs


Changes:

=====================================
compiler/GHC.hs
=====================================
@@ -395,7 +395,7 @@ import GHC.Types.Name.Ppr
 import GHC.Types.TypeEnv
 import GHC.Types.BreakInfo
 import GHC.Types.PkgQual
-import GHC.Types.Unique.DSet
+import GHC.Types.Unique.Set
 
 import GHC.Unit
 import GHC.Unit.Env
@@ -603,7 +603,7 @@ setSessionDynFlags dflags0 = do
   logger <- getLogger
   dflags <- checkNewDynFlags logger dflags0
   let all_uids = hsc_all_home_unit_ids hsc_env
-  case uniqDSetToList all_uids of
+  case uniqSetToAscList all_uids of
     [uid] -> do
       setUnitDynFlagsNoCheck uid dflags
       modifySession (hscUpdateLoggerFlags . hscSetActiveUnitId (homeUnitId_ dflags))
@@ -1379,7 +1379,7 @@ data ModuleInfo = ModuleInfo {
 -- | Request information about a loaded 'Module'
 getModuleInfo :: GhcMonad m => Module -> m (Maybe ModuleInfo)  -- XXX: Maybe X
 getModuleInfo mdl = withSession $ \hsc_env -> do
-  if moduleUnitId mdl `elementOfUniqDSet` hsc_all_home_unit_ids hsc_env
+  if moduleUnitId mdl `elementOfUniqSet` hsc_all_home_unit_ids hsc_env
         then liftIO $ getHomeModuleInfo hsc_env mdl
         else liftIO $ getPackageModuleInfo hsc_env mdl
 


=====================================
compiler/GHC/Driver/CodeOutput.hs
=====================================
@@ -56,7 +56,7 @@ import GHC.Types.SrcLoc
 import GHC.Types.CostCentre
 import GHC.Types.ForeignStubs
 import GHC.Types.Unique.Supply ( mkSplitUniqSupply )
-import GHC.Types.Unique.DSet
+import GHC.Types.Unique.Set
 
 import System.Directory
 import System.FilePath
@@ -164,7 +164,7 @@ outputC :: Logger
         -> IO a
 outputC logger dflags filenm cmm_stream unit_deps =
   withTiming logger (text "C codegen") (\a -> seq a () {- FIXME -}) $ do
-    let pkg_names = map unitIdString (uniqDSetToAscList unit_deps)
+    let pkg_names = map unitIdString (uniqSetToAscList unit_deps)
     doOutput filenm $ \ h -> do
       hPutStr h ("/* GHC_PACKAGES " ++ unwords pkg_names ++ "\n*/\n")
       hPutStr h "#include \"Stg.h\"\n"


=====================================
compiler/GHC/Driver/Main.hs
=====================================
@@ -245,7 +245,7 @@ import GHC.Types.Name.Ppr
 import GHC.Types.Name.Set (NonCaffySet)
 import GHC.Types.TyThing
 import GHC.Types.HpcInfo
-import GHC.Types.Unique.DSet
+import GHC.Types.Unique.Set
 
 import GHC.Utils.Fingerprint ( Fingerprint )
 import GHC.Utils.Panic
@@ -1457,15 +1457,15 @@ checkSafeImports tcg_env
         clearDiagnostics
 
         -- Check safe imports are correct
-        safePkgs <- mkUniqDSet <$> mapMaybeM checkSafe safeImps
+        safePkgs <- mkUniqSet <$> mapMaybeM checkSafe safeImps
         safeErrs <- getDiagnostics
         clearDiagnostics
 
         -- Check non-safe imports are correct if inferring safety
         -- See the Note [Safe Haskell Inference]
         (infErrs, infPkgs) <- case (safeInferOn dflags) of
-          False -> return (emptyMessages, emptyUniqDSet)
-          True -> do infPkgs <- mkUniqDSet <$> mapMaybeM checkSafe regImps
+          False -> return (emptyMessages, emptyUniqSet)
+          True -> do infPkgs <- mkUniqSet <$> mapMaybeM checkSafe regImps
                      infErrs <- getDiagnostics
                      clearDiagnostics
                      return (infErrs, infPkgs)
@@ -1521,7 +1521,7 @@ checkSafeImports tcg_env
     pkgTrustReqs dflags req inf infPassed | safeInferOn dflags
                                   && not (safeHaskellModeEnabled dflags) && infPassed
                                    = emptyImportAvails {
-                                       imp_trust_pkgs = req `unionUniqDSets` inf
+                                       imp_trust_pkgs = req `unionUniqSets` inf
                                    }
     pkgTrustReqs dflags _   _ _ | safeHaskell dflags == Sf_Unsafe
                          = emptyImportAvails
@@ -1545,7 +1545,7 @@ hscGetSafe hsc_env m l = runHsc hsc_env $ do
     (self, pkgs) <- hscCheckSafe' m l
     good         <- isEmptyMessages `fmap` getDiagnostics
     clearDiagnostics -- don't want them printed...
-    let pkgs' | Just p <- self = addOneToUniqDSet pkgs p
+    let pkgs' | Just p <- self = addOneToUniqSet pkgs p
               | otherwise      = pkgs
     return (good, pkgs')
 
@@ -1651,7 +1651,7 @@ hscCheckSafe' m l = do
 checkPkgTrust :: UnitIdSet -> Hsc ()
 checkPkgTrust pkgs = do
     hsc_env <- getHscEnv
-    let errors = foldr go emptyBag $ uniqDSetToList pkgs
+    let errors = foldr go emptyBag $ uniqSetToAscList pkgs
         state  = hsc_units hsc_env
         go pkg acc
             | unitIsTrusted $ unsafeLookupUnitId state pkg
@@ -1699,7 +1699,7 @@ markUnsafeInfer tcg_env whyUnsafe = do
       False -> return tcg_env
 
   where
-    wiped_trust   = (tcg_imports tcg_env) { imp_trust_pkgs = emptyUniqDSet }
+    wiped_trust   = (tcg_imports tcg_env) { imp_trust_pkgs = emptyUniqSet }
     pprMod        = ppr $ moduleName $ tcg_mod tcg_env
     whyUnsafe' df = vcat [ quotes pprMod <+> text "has been inferred as unsafe!"
                          , text "Reason:"
@@ -2060,7 +2060,7 @@ hscCompileCmmFile hsc_env original_filename filename output_filename = runHsc hs
                   in NoStubs `appendStubC` ip_init
               | otherwise     = NoStubs
         (_output_filename, (_stub_h_exists, stub_c_exists), _foreign_fps, _caf_infos)
-          <- codeOutput logger tmpfs llvm_config dflags (hsc_units hsc_env) cmm_mod output_filename no_loc foreign_stubs [] emptyUniqDSet
+          <- codeOutput logger tmpfs llvm_config dflags (hsc_units hsc_env) cmm_mod output_filename no_loc foreign_stubs [] emptyUniqSet
              rawCmms
         return stub_c_exists
   where


=====================================
compiler/GHC/Driver/Make.hs
=====================================
@@ -107,7 +107,7 @@ import GHC.Types.SourceFile
 import GHC.Types.SourceError
 import GHC.Types.SrcLoc
 import GHC.Types.Unique.Map
-import GHC.Types.Unique.DSet
+import GHC.Types.Unique.Set
 import GHC.Types.PkgQual
 
 import GHC.Unit
@@ -491,7 +491,7 @@ load how_much = loadWithCache noIfaceCache how_much
 
 mkBatchMsg :: HscEnv -> Messager
 mkBatchMsg hsc_env =
-  if sizeUniqDSet (hsc_all_home_unit_ids hsc_env) > 1
+  if sizeUniqSet (hsc_all_home_unit_ids hsc_env) > 1
     -- This also displays what unit each module is from.
     then batchMultiMsg
     else batchMsg
@@ -1745,16 +1745,16 @@ downsweep hsc_env old_summaries excl_mods allow_dup_roots
 checkHomeUnitsClosed ::  UnitEnv -> UnitIdSet -> [(UnitId, UnitId)] -> [DriverMessages]
 -- Fast path, trivially closed.
 checkHomeUnitsClosed ue home_id_set home_imp_ids
-  | sizeUniqDSet home_id_set == 1 = []
+  | sizeUniqSet home_id_set == 1 = []
   | otherwise =
-  let res = foldr (\ids acc -> unionUniqDSets acc $ loop ids) emptyUniqDSet home_imp_ids
+  let res = foldr (\ids acc -> unionUniqSets acc $ loop ids) emptyUniqSet home_imp_ids
   -- Now check whether everything which transitively depends on a home_unit is actually a home_unit
   -- These units are the ones which we need to load as home packages but failed to do for some reason,
   -- it's a bug in the tool invoking GHC.
-      bad_unit_ids = res `minusUniqDSet` home_id_set
-  in if isEmptyUniqDSet bad_unit_ids
+      bad_unit_ids = res `minusUniqSet` home_id_set
+  in if isEmptyUniqSet bad_unit_ids
         then []
-        else [singleMessage $ mkPlainErrorMsgEnvelope rootLoc $ DriverHomePackagesNotClosed (uniqDSetToAscList bad_unit_ids)]
+        else [singleMessage $ mkPlainErrorMsgEnvelope rootLoc $ DriverHomePackagesNotClosed (uniqSetToAscList bad_unit_ids)]
 
   where
     rootLoc = mkGeneralSrcSpan (fsLit "<command line>")
@@ -1768,21 +1768,21 @@ checkHomeUnitsClosed ue home_id_set home_imp_ids
         Nothing -> pprPanic "uid not found" (ppr uid)
         Just ui ->
           let depends = unitDepends ui
-              home_depends  = mkUniqDSet depends `intersectUniqDSets` home_id_set
-              other_depends = mkUniqDSet depends `minusUniqDSet` home_id_set
+              home_depends  = mkUniqSet depends `intersectUniqSets` home_id_set
+              other_depends = mkUniqSet depends `minusUniqSet` home_id_set
           in
             -- Case 1: The unit directly depends on a home_id
-            if not (isEmptyUniqDSet home_depends)
+            if not (isEmptyUniqSet home_depends)
               then
                 let res :: UnitIdSet
-                    res = foldr (\ide acc -> acc `unionUniqDSets` loop (from_uid, ide)) emptyUniqDSet $ uniqDSetToList other_depends
-                in addOneToUniqDSet res uid
+                    res = foldr (\ide acc -> acc `unionUniqSets` loop (from_uid, ide)) emptyUniqSet $ uniqSetToAscList other_depends
+                in addOneToUniqSet res uid
              -- Case 2: Check the rest of the dependencies, and then see if any of them depended on
               else
-                let res = foldr (\ide acc -> acc `unionUniqDSets` loop (from_uid, ide)) emptyUniqDSet $ uniqDSetToList other_depends
+                let res = foldr (\ide acc -> acc `unionUniqSets` loop (from_uid, ide)) emptyUniqSet $ uniqSetToAscList other_depends
                 in
-                  if not (isEmptyUniqDSet res)
-                    then addOneToUniqDSet res uid
+                  if not (isEmptyUniqSet res)
+                    then addOneToUniqSet res uid
                     else res
 
 -- | Update the every ModSummary that is depended on


=====================================
compiler/GHC/Driver/Pipeline.hs
=====================================
@@ -108,7 +108,7 @@ import GHC.Types.Target
 import GHC.Types.SrcLoc
 import GHC.Types.SourceFile
 import GHC.Types.SourceError
-import GHC.Types.Unique.DSet
+import GHC.Types.Unique.Set
 
 import GHC.Unit
 import GHC.Unit.Env
@@ -410,8 +410,8 @@ link' logger tmpfs dflags unit_env batch_attempt_linking mHscMessager hpt
             home_mod_infos = eltsHpt hpt
 
             -- the packages we depend on
-            pkg_deps  = uniqDSetToList
-                          $ unionManyUniqDSets
+            pkg_deps  = uniqSetToAscList
+                          $ unionManyUniqSets
                           $ fmap (dep_direct_pkgs . mi_deps . hm_iface)
                           $ home_mod_infos
 


=====================================
compiler/GHC/HsToCore/Usage.hs
=====================================
@@ -26,7 +26,6 @@ import GHC.Utils.Monad
 import GHC.Types.Name
 import GHC.Types.Name.Set ( NameSet, allUses )
 import GHC.Types.Unique.Set
-import GHC.Types.Unique.DSet
 
 import GHC.Unit
 import GHC.Unit.Env
@@ -256,7 +255,7 @@ mk_mod_usage_info uc home_unit home_unit_ids this_mod direct_imports used_names
     --     (need to recompile if its export list changes: export_fprint)
     mkUsage :: Module -> ModIface -> Maybe Usage
     mkUsage mod iface
-      | not $ toUnitId (moduleUnit mod) `elementOfUniqDSet` home_unit_ids
+      | not $ toUnitId (moduleUnit mod) `elementOfUniqSet` home_unit_ids
       = Just $ UsagePackageModule{ usg_mod      = mod,
                                    usg_mod_hash = mod_hash,
                                    usg_safe     = imp_safe }


=====================================
compiler/GHC/Iface/Load.hs
=====================================
@@ -94,6 +94,7 @@ import GHC.Types.SourceFile
 import GHC.Types.SafeHaskell
 import GHC.Types.TypeEnv
 import GHC.Types.Unique.DSet
+import GHC.Types.Unique.Set
 import GHC.Types.SrcLoc
 import GHC.Types.TyThing
 import GHC.Types.PkgQual
@@ -504,7 +505,7 @@ loadInterface doc_str mod from
         -- overlapping instances.
         ; massertPpr
               ((isOneShot (ghcMode (hsc_dflags hsc_env)))
-                || not (moduleUnitId mod `elementOfUniqDSet` hsc_all_home_unit_ids hsc_env)
+                || not (moduleUnitId mod `elementOfUniqSet` hsc_all_home_unit_ids hsc_env)
                 || mod == gHC_PRIM)
                 (text "Attempting to load home package interface into the EPS" $$ ppr hug $$ doc_str $$ ppr mod $$ ppr (moduleUnitId mod))
         ; ignore_prags      <- goptM Opt_IgnoreInterfacePragmas


=====================================
compiler/GHC/Iface/Recomp.hs
=====================================
@@ -59,7 +59,6 @@ import GHC.Types.SrcLoc
 import GHC.Types.Unique.Set
 import GHC.Types.Fixity.Env
 import GHC.Types.Unique.Map
-import GHC.Types.Unique.DSet
 import GHC.Unit.External
 import GHC.Unit.Finder
 import GHC.Unit.State
@@ -618,8 +617,8 @@ checkDependencies hsc_env summary iface
    all_home_units = hsc_all_home_unit_ids hsc_env
    units         = hsc_units hsc_env
    prev_dep_mods = map (second gwib_mod) $ Set.toAscList $ dep_direct_mods (mi_deps iface)
-   prev_dep_pkgs = uniqDSetToAscList (unionUniqDSets (dep_direct_pkgs (mi_deps iface))
-                                     (dep_plugin_pkgs (mi_deps iface)))
+   prev_dep_pkgs = uniqSetToAscList (unionUniqSets (dep_direct_pkgs (mi_deps iface))
+                                    (dep_plugin_pkgs (mi_deps iface)))
 
    implicit_deps = map (fsLit "Implicit",) (implicitPackageDeps dflags)
 
@@ -634,7 +633,7 @@ checkDependencies hsc_env summary iface
 
 
    classify _ (Found _ mod)
-    | (toUnitId $ moduleUnit mod) `elementOfUniqDSet` all_home_units = Right (Left ((toUnitId $ moduleUnit mod), moduleName mod))
+    | (toUnitId $ moduleUnit mod) `elementOfUniqSet` all_home_units = Right (Left ((toUnitId $ moduleUnit mod), moduleName mod))
     | otherwise = Right (Right (moduleNameFS (moduleName mod), toUnitId $ moduleUnit mod))
    classify reason _ = Left (RecompBecause reason)
 


=====================================
compiler/GHC/Linker/Loader.hs
=====================================
@@ -63,6 +63,7 @@ import GHC.Types.Name
 import GHC.Types.Name.Env
 import GHC.Types.SrcLoc
 import GHC.Types.Unique.DSet
+import GHC.Types.Unique.Set
 import GHC.Types.Unique.DFM
 
 import GHC.Utils.Outputable
@@ -156,7 +157,7 @@ emptyLoaderState = LoaderState
   --
   -- The linker's symbol table is populated with RTS symbols using an
   -- explicit list.  See rts/Linker.c for details.
-  where init_pkgs = unitUDFM rtsUnitId (LoadedPkgInfo rtsUnitId [] [] emptyUniqDSet)
+  where init_pkgs = unitUDFM rtsUnitId (LoadedPkgInfo rtsUnitId [] [] emptyUniqSet)
 
 extendLoadedEnv :: Interp -> [(Name,ForeignHValue)] -> IO ()
 extendLoadedEnv interp new_bindings =
@@ -222,12 +223,12 @@ loadDependencies interp hsc_env pls span needed_mods = do
    -- Link the packages and modules required
    pls1 <- loadPackages' interp hsc_env pkgs pls
    (pls2, succ) <- loadModuleLinkables interp hsc_env pls1 lnks
-   let this_pkgs_loaded = udfmRestrictKeys all_pkgs_loaded $ getUniqDSet trans_pkgs_needed
+   let this_pkgs_loaded = udfmRestrictKeys all_pkgs_loaded $ getUniqDSet $ mkUniqDSet $ nonDetEltsUniqSet trans_pkgs_needed
        all_pkgs_loaded = pkgs_loaded pls2
-       trans_pkgs_needed = unionManyUniqDSets (this_pkgs_needed : [ loaded_pkg_trans_deps pkg
-                                                                  | pkg_id <- uniqDSetToList this_pkgs_needed
-                                                                  , Just pkg <- [lookupUDFM all_pkgs_loaded pkg_id]
-                                                                  ])
+       trans_pkgs_needed = unionManyUniqSets (this_pkgs_needed : [ loaded_pkg_trans_deps pkg
+                                                                 | pkg_id <- uniqSetToAscList this_pkgs_needed
+                                                                 , Just pkg <- [lookupUDFM all_pkgs_loaded pkg_id]
+                                                                 ])
    return (pls2, succ, all_lnks, this_pkgs_loaded)
 
 
@@ -325,19 +326,19 @@ loadCmdLineLibs' :: Interp -> HscEnv -> LoaderState -> IO LoaderState
 loadCmdLineLibs' interp hsc_env pls = snd <$>
     foldM
       (\(done', pls') cur_uid -> load done' cur_uid pls')
-      (emptyUniqDSet, pls)
-      (uniqDSetToList $ hsc_all_home_unit_ids hsc_env)
+      (emptyUniqSet, pls)
+      (uniqSetToAscList $ hsc_all_home_unit_ids hsc_env)
 
   where
     load :: UnitIdSet -> UnitId -> LoaderState -> IO (UnitIdSet, LoaderState)
-    load done uid pls | uid `elementOfUniqDSet` done = return (done, pls)
+    load done uid pls | uid `elementOfUniqSet` done = return (done, pls)
     load done uid pls = do
       let hsc' = hscSetActiveUnitId uid hsc_env
       -- Load potential dependencies first
       (done', pls') <- foldM (\(done', pls') uid -> load done' uid pls') (done, pls)
                              (homeUnitDepends (hsc_units hsc'))
       pls'' <- loadCmdLineLibs'' interp hsc' pls'
-      return $ (addOneToUniqDSet done' uid, pls'')
+      return $ (addOneToUniqSet done' uid, pls'')
 
 loadCmdLineLibs''
   :: Interp
@@ -701,16 +702,16 @@ getLinkDeps hsc_env pls replace_osuf span mods
           -- if --make uses the oneShot code path (see MultiLayerModulesTH_* tests)
           if isOneShot (ghcMode dflags)
             then follow_deps (filterOut isInteractiveModule mods)
-                              emptyUniqDSet emptyUniqDSet;
+                              emptyUniqDSet emptyUniqSet;
             else do
               (pkgs, mmods) <- unzip <$> mapM get_mod_info all_home_mods
-              return (catMaybes mmods, unionManyUniqDSets (init_pkg_set : pkgs))
+              return (catMaybes mmods, unionManyUniqSets (init_pkg_set : pkgs))
 
       ; let
         -- 2.  Exclude ones already linked
         --      Main reason: avoid findModule calls in get_linkable
             (mods_needed, links_got) = partitionEithers (map split_mods mods_s)
-            pkgs_needed = eltsUDFM $ getUniqDSet pkgs_s `minusUDFM` pkgs_loaded pls
+            pkgs_needed = eltsUDFM $ getUniqDSet (mkUniqDSet $ uniqSetToAscList pkgs_s) `minusUDFM` pkgs_loaded pls
 
             split_mods mod =
                 let is_linked = findModuleLinkable_maybe (objs_loaded pls) mod <|> findModuleLinkable_maybe (bcos_loaded pls) mod
@@ -751,10 +752,10 @@ getLinkDeps hsc_env pls replace_osuf span mods
               in make_deps_loop (found_units, deps `Set.union` found_mods) (todo_boot_mods ++ nexts)
             Nothing ->
               let (ModNodeKeyWithUid _ uid) = nk
-              in make_deps_loop (addOneToUniqDSet found_units uid, found_mods) nexts
+              in make_deps_loop (addOneToUniqSet found_units uid, found_mods) nexts
 
     mkNk m = ModNodeKeyWithUid (GWIB (moduleName m) NotBoot) (moduleUnitId m)
-    (init_pkg_set, all_deps) = make_deps_loop (emptyUniqDSet, Set.empty) $ map mkNk (filterOut isInteractiveModule mods)
+    (init_pkg_set, all_deps) = make_deps_loop (emptyUniqSet, Set.empty) $ map mkNk (filterOut isInteractiveModule mods)
 
     all_home_mods = [with_uid | NodeKey_Module with_uid <- Set.toList all_deps]
 
@@ -814,12 +815,12 @@ getLinkDeps hsc_env pls replace_osuf span mods
             acc_mods'  = case hsc_home_unit_maybe hsc_env of
                           Nothing -> acc_mods
                           Just home_unit -> addListToUniqDSet acc_mods (mod : map (mkHomeModule home_unit) mod_deps)
-            acc_pkgs'  = addListToUniqDSet acc_pkgs (uniqDSetToList pkg_deps)
+            acc_pkgs'  = addListToUniqSet acc_pkgs (uniqSetToAscList pkg_deps)
 
           case hsc_home_unit_maybe hsc_env of
             Just home_unit | isHomeUnit home_unit pkg ->  follow_deps (mod_deps' ++ mods)
                                                                       acc_mods' acc_pkgs'
-            _ ->  follow_deps mods acc_mods (addOneToUniqDSet acc_pkgs' (toUnitId pkg))
+            _ ->  follow_deps mods acc_mods (addOneToUniqSet acc_pkgs' (toUnitId pkg))
         where
            msg = text "need to link module" <+> ppr mod <+>
                   text "due to use of Template Haskell"
@@ -1372,10 +1373,10 @@ loadPackages' interp hsc_env new_pks pls = do
              ; pkgs' <- link pkgs deps
                 -- Now link the package itself
              ; (hs_cls, extra_cls) <- loadPackage interp hsc_env pkg_cfg
-             ; let trans_deps = unionManyUniqDSets [ addOneToUniqDSet (loaded_pkg_trans_deps loaded_pkg_info) dep_pkg
-                                                   | dep_pkg <- deps
-                                                   , Just loaded_pkg_info <- pure (lookupUDFM pkgs' dep_pkg)
-                                                   ]
+             ; let trans_deps = unionManyUniqSets [ addOneToUniqSet (loaded_pkg_trans_deps loaded_pkg_info) dep_pkg
+                                                  | dep_pkg <- deps
+                                                  , Just loaded_pkg_info <- pure (lookupUDFM pkgs' dep_pkg)
+                                                  ]
              ; return (addToUDFM pkgs' new_pkg (LoadedPkgInfo new_pkg hs_cls extra_cls trans_deps)) }
 
         | otherwise


=====================================
compiler/GHC/Rename/Names.hs
=====================================
@@ -72,7 +72,7 @@ import GHC.Types.Id
 import GHC.Types.HpcInfo
 import GHC.Types.PkgQual
 import GHC.Types.GREInfo (ConInfo(..))
-import GHC.Types.Unique.DSet
+import GHC.Types.Unique.Set
 
 import GHC.Unit
 import GHC.Unit.Module.Warnings
@@ -211,8 +211,8 @@ rnImports imports = do
     let merged_import_avail = clobberSourceImports imp_avails
     dflags <- getDynFlags
     let final_import_avail  =
-          merged_import_avail { imp_dep_direct_pkgs = mkUniqDSet (implicitPackageDeps dflags)
-                                                        `unionUniqDSets` imp_dep_direct_pkgs merged_import_avail}
+          merged_import_avail { imp_dep_direct_pkgs = mkUniqSet (implicitPackageDeps dflags)
+                                                        `unionUniqSets` imp_dep_direct_pkgs merged_import_avail}
     return (decls, rdr_env, final_import_avail, hpc_usage)
 
   where
@@ -534,7 +534,7 @@ calculateAvails home_unit other_home_units iface mod_safe' want_boot imported_by
 
       -- Trusted packages are a lot like orphans.
       trusted_pkgs | mod_safe' = dep_trusted_pkgs deps
-                   | otherwise = emptyUniqDSet
+                   | otherwise = emptyUniqSet
 
 
       pkg = moduleUnit (mi_module iface)
@@ -547,11 +547,11 @@ calculateAvails home_unit other_home_units iface mod_safe' want_boot imported_by
         | isHomeUnit home_unit pkg = ptrust
         | otherwise = False
 
-      dependent_pkgs = if toUnitId pkg `elementOfUniqDSet` other_home_units
-                        then emptyUniqDSet
-                        else unitUniqDSet ipkg
+      dependent_pkgs = if toUnitId pkg `elementOfUniqSet` other_home_units
+                        then emptyUniqSet
+                        else unitUniqSet ipkg
 
-      direct_mods = mkModDeps $ if toUnitId pkg `elementOfUniqDSet` other_home_units
+      direct_mods = mkModDeps $ if toUnitId pkg `elementOfUniqSet` other_home_units
                       then S.singleton (moduleUnitId imp_mod, (GWIB (moduleName imp_mod) want_boot))
                       else S.empty
 


=====================================
compiler/GHC/Tc/Module.hs
=====================================
@@ -143,7 +143,7 @@ import GHC.Types.Id.Info( IdDetails(..) )
 import GHC.Types.Var.Env
 import GHC.Types.TypeEnv
 import GHC.Types.Unique.FM
-import GHC.Types.Unique.DSet
+import GHC.Types.Unique.Set
 import GHC.Types.Name
 import GHC.Types.Name.Env
 import GHC.Types.Name.Set
@@ -2933,7 +2933,7 @@ pprTcGblEnv (TcGblEnv { tcg_type_env  = type_env,
          , text "Dependent modules:" <+>
                 (ppr . sort . installedModuleEnvElts $ imp_direct_dep_mods imports)
          , text "Dependent packages:" <+>
-                ppr (uniqDSetToAscList $ imp_dep_direct_pkgs imports)]
+                ppr (uniqSetToAscList $ imp_dep_direct_pkgs imports)]
                 -- The use of sort is just to reduce unnecessary
                 -- wobbling in testsuite output
 


=====================================
compiler/GHC/Tc/Types.hs
=====================================
@@ -142,7 +142,7 @@ import GHC.Types.SourceFile
 import GHC.Types.SrcLoc
 import GHC.Types.Var.Set
 import GHC.Types.Unique.FM
-import GHC.Types.Unique.DSet
+import GHC.Types.Unique.Set
 import GHC.Types.Basic
 import GHC.Types.CostCentre.State
 import GHC.Types.HpcInfo
@@ -1368,9 +1368,9 @@ plusModDeps = plusInstalledModuleEnv plus_mod_dep
 emptyImportAvails :: ImportAvails
 emptyImportAvails = ImportAvails { imp_mods          = emptyModuleEnv,
                                    imp_direct_dep_mods = emptyInstalledModuleEnv,
-                                   imp_dep_direct_pkgs = emptyUniqDSet,
+                                   imp_dep_direct_pkgs = emptyUniqSet,
                                    imp_sig_mods      = [],
-                                   imp_trust_pkgs    = emptyUniqDSet,
+                                   imp_trust_pkgs    = emptyUniqSet,
                                    imp_trust_own_pkg = False,
                                    imp_boot_mods   = emptyInstalledModuleEnv,
                                    imp_orphs         = [],
@@ -1399,8 +1399,8 @@ plusImportAvails
                   imp_orphs = orphs2, imp_finsts = finsts2 })
   = ImportAvails { imp_mods          = plusModuleEnv_C (++) mods1 mods2,
                    imp_direct_dep_mods = ddmods1 `plusModDeps` ddmods2,
-                   imp_dep_direct_pkgs      = ddpkgs1 `unionUniqDSets` ddpkgs2,
-                   imp_trust_pkgs    = tpkgs1 `unionUniqDSets` tpkgs2,
+                   imp_dep_direct_pkgs      = ddpkgs1 `unionUniqSets` ddpkgs2,
+                   imp_trust_pkgs    = tpkgs1 `unionUniqSets` tpkgs2,
                    imp_trust_own_pkg = tself1 || tself2,
                    imp_boot_mods   = srs1 `plusModDeps` srcs2,
                    imp_sig_mods      = unionListsOrd sig_mods1 sig_mods2,


=====================================
compiler/GHC/Types/Unique/Set.hs
=====================================
@@ -44,6 +44,7 @@ module GHC.Types.Unique.Set (
         nonDetEltsUniqSet,
         nonDetKeysUniqSet,
         nonDetStrictFoldUniqSet,
+        uniqSetToAscList,
     ) where
 
 import GHC.Prelude
@@ -55,6 +56,8 @@ import Data.Coerce
 import GHC.Utils.Outputable
 import Data.Data
 import qualified Data.Semigroup as Semi
+import Data.List (sort)
+import GHC.Utils.Binary
 
 -- Note [UniqSet invariant]
 -- ~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -159,6 +162,9 @@ lookupUniqSet_Directly (UniqSet s) k = lookupUFM_Directly s k
 nonDetEltsUniqSet :: UniqSet elt -> [elt]
 nonDetEltsUniqSet = nonDetEltsUFM . getUniqSet'
 
+uniqSetToAscList :: Ord elt => UniqSet elt -> [elt]
+uniqSetToAscList = sort . nonDetEltsUniqSet
+
 -- See Note [Deterministic UniqFM] to learn about nondeterminism.
 -- If you use this please provide a justification why it doesn't introduce
 -- nondeterminism.
@@ -180,6 +186,10 @@ mapUniqSet f = mkUniqSet . map f . nonDetEltsUniqSet
 instance Eq (UniqSet a) where
   UniqSet a == UniqSet b = equalKeysUFM a b
 
+instance (Uniquable a, Ord a, Binary a) => Binary (UniqSet a) where
+  put_ bh = put_ bh . uniqSetToAscList
+  get  bh = mkUniqSet <$> get bh
+
 getUniqSet :: UniqSet a -> UniqFM a a
 getUniqSet = getUniqSet'
 


=====================================
compiler/GHC/Unit/Env.hs
=====================================
@@ -81,7 +81,7 @@ import GHC.Utils.Misc (HasDebugCallStack)
 import GHC.Driver.DynFlags
 import GHC.Utils.Outputable
 import GHC.Utils.Panic (pprPanic)
-import GHC.Types.Unique.DSet
+import GHC.Types.Unique.Set
 import GHC.Unit.Module.ModIface
 import GHC.Unit.Module
 import qualified Data.Set as Set
@@ -341,7 +341,7 @@ unitEnv_lookup :: UnitEnvGraphKey -> UnitEnvGraph v -> v
 unitEnv_lookup u env = fromJust $ unitEnv_lookup_maybe u env
 
 unitEnv_keys :: UnitEnvGraph v -> UnitIdSet
-unitEnv_keys env = mkUniqDSet $ Map.keys (unitEnv_graph env)
+unitEnv_keys env = mkUniqSet $ Map.keys (unitEnv_graph env)
 
 unitEnv_elts :: UnitEnvGraph v -> [(UnitEnvGraphKey, v)]
 unitEnv_elts env = Map.toList (unitEnv_graph env)


=====================================
compiler/GHC/Unit/Module/Deps.hs
=====================================
@@ -30,7 +30,7 @@ import GHC.Unit.Module.Imported
 import GHC.Unit.Module
 import GHC.Unit.Home
 import GHC.Unit.State
-import GHC.Types.Unique.DSet
+import GHC.Types.Unique.Set
 
 import GHC.Utils.Fingerprint
 import GHC.Utils.Binary
@@ -113,7 +113,7 @@ data Dependencies = Deps
 mkDependencies :: HomeUnit -> Module -> ImportAvails -> [Module] -> Dependencies
 mkDependencies home_unit mod imports plugin_mods =
   let (home_plugins, external_plugins) = partition (isHomeUnit home_unit . moduleUnit) plugin_mods
-      plugin_units = mkUniqDSet (map (toUnitId . moduleUnit) external_plugins)
+      plugin_units = mkUniqSet (map (toUnitId . moduleUnit) external_plugins)
       all_direct_mods = foldr (\mn m -> extendInstalledModuleEnv m mn (GWIB (moduleName mn) NotBoot))
                               (imp_direct_dep_mods imports)
                               (map (fmap toUnitId) home_plugins)
@@ -201,11 +201,11 @@ instance Binary Dependencies where
 noDependencies :: Dependencies
 noDependencies = Deps
   { dep_direct_mods  = mempty
-  , dep_direct_pkgs  = emptyUniqDSet
-  , dep_plugin_pkgs  = emptyUniqDSet
+  , dep_direct_pkgs  = emptyUniqSet
+  , dep_plugin_pkgs  = emptyUniqSet
   , dep_sig_mods     = []
   , dep_boot_mods    = mempty
-  , dep_trusted_pkgs = emptyUniqDSet
+  , dep_trusted_pkgs = emptyUniqSet
   , dep_orphs        = []
   , dep_finsts       = []
   }
@@ -225,7 +225,7 @@ pprDeps unit_state (Deps { dep_direct_mods = dmods
           text "boot module dependencies:"    <+> ppr_set ppr bmods,
           text "direct package dependencies:" <+> ppr_unitIdSet ppr pkgs,
           text "plugin package dependencies:" <+> ppr_unitIdSet ppr plgns,
-          if isEmptyUniqDSet tps
+          if isEmptyUniqSet tps
             then empty
             else text "trusted package dependencies:" <+> ppr_unitIdSet ppr tps,
           text "orphans:" <+> fsep (map ppr orphs),
@@ -239,7 +239,7 @@ pprDeps unit_state (Deps { dep_direct_mods = dmods
     ppr_set w = fsep . fmap w . Set.toAscList
 
     ppr_unitIdSet :: (UnitId -> SDoc) -> UnitIdSet -> SDoc
-    ppr_unitIdSet w = fsep . fmap w . sort . uniqDSetToList
+    ppr_unitIdSet w = fsep . fmap w . sort . uniqSetToAscList
 
 -- | Records modules for which changes may force recompilation of this module
 -- See wiki: https://gitlab.haskell.org/ghc/ghc/wikis/commentary/compiler/recompilation-avoidance


=====================================
compiler/GHC/Unit/State.hs
=====================================
@@ -1362,7 +1362,7 @@ mergeDatabases logger = foldM merge (emptyUniqMap, emptyUniqMap) . zip [1..]
     merge (pkg_map, prec_map) (i, UnitDatabase db_path db) = do
       debugTraceMsg logger 2 $
           text "loading package database" <+> text db_path
-      forM_ (uniqDSetToList override_set) $ \pkg ->
+      forM_ (uniqSetToAscList override_set) $ \pkg ->
           debugTraceMsg logger 2 $
               text "package" <+> ppr pkg <+>
               text "overrides a previously defined package"
@@ -1375,7 +1375,7 @@ mergeDatabases logger = foldM merge (emptyUniqMap, emptyUniqMap) . zip [1..]
       -- ones that get overridden.  Compute this just to give some
       -- helpful debug messages at -v2
       override_set :: UnitIdSet
-      override_set = mkUniqDSet $ nonDetKeysUniqMap $ intersectUniqMap db_map pkg_map
+      override_set = mkUniqSet $ nonDetKeysUniqMap $ intersectUniqMap db_map pkg_map
 
       -- Now merge the sets together (NB: in case of duplicate,
       -- first argument preferred)
@@ -1687,7 +1687,7 @@ mkUnitState logger cfg = do
   let !state = UnitState
          { preloadUnits                 = dep_preload
          , explicitUnits                = explicit_pkgs
-         , homeUnitDepends              = uniqDSetToList home_unit_deps
+         , homeUnitDepends              = uniqSetToAscList home_unit_deps
          , unitInfoMap                  = pkg_db
          , preloadClosure               = emptyUniqSet
          , moduleNameProvidersMap       = mod_map
@@ -1701,14 +1701,14 @@ mkUnitState logger cfg = do
   return (state, raw_dbs)
 
 selectHptFlag :: UnitIdSet -> PackageFlag -> Bool
-selectHptFlag home_units (ExposePackage _ (UnitIdArg uid) _) | toUnitId uid `elementOfUniqDSet` home_units = True
+selectHptFlag home_units (ExposePackage _ (UnitIdArg uid) _) | toUnitId uid `elementOfUniqSet` home_units = True
 selectHptFlag _ _ = False
 
 selectHomeUnits :: UnitIdSet -> [PackageFlag] -> UnitIdSet
-selectHomeUnits home_units flags = foldl' go emptyUniqDSet flags
+selectHomeUnits home_units flags = foldl' go emptyUniqSet flags
   where
     go :: UnitIdSet -> PackageFlag -> UnitIdSet
-    go cur (ExposePackage _ (UnitIdArg uid) _) | toUnitId uid `elementOfUniqDSet` home_units = addOneToUniqDSet cur (toUnitId uid)
+    go cur (ExposePackage _ (UnitIdArg uid) _) | toUnitId uid `elementOfUniqSet` home_units = addOneToUniqSet cur (toUnitId uid)
     -- MP: This does not yet support thinning/renaming
     go cur _ = cur
 


=====================================
compiler/GHC/Unit/Types.hs
=====================================
@@ -94,6 +94,7 @@ import GHC.Prelude
 
 import GHC.Types.Unique
 import GHC.Types.Unique.DSet
+import GHC.Types.Unique.Set
 import GHC.Utils.Binary
 import GHC.Utils.Outputable
 import GHC.Data.FastString
@@ -540,7 +541,7 @@ pprUnitId (UnitId fs) = sdocOption sdocUnitIdForUser ($ fs)
 -- code for.
 type DefUnitId = Definite UnitId
 
-type UnitIdSet = UniqDSet UnitId
+type UnitIdSet = UniqSet UnitId
 
 unitIdString :: UnitId -> String
 unitIdString = unpackFS . unitIdFS



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0e59433f8275177f4f6f795b67e1028fbd282055
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/20230525/ca034edf/attachment-0001.html>


More information about the ghc-commits mailing list