[Git][ghc/ghc][wip/unitidset] ghci module fixes

[Josh Meredith (@JoshMeredith)]

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


Commits:
b7666f0e by Josh Meredith at 2023-04-25T16:39:52+00:00
ghci module fixes

- - - - -


4 changed files:

- compiler/GHC.hs
- compiler/GHC/Driver/Pipeline.hs
- compiler/GHC/HsToCore/Usage.hs
- ghc/GHCi/UI.hs


Changes:

=====================================
compiler/GHC.hs
=====================================
@@ -395,6 +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.Unit
 import GHC.Unit.Env
@@ -418,8 +419,6 @@ import Data.Typeable    ( Typeable )
 import Data.Word        ( Word8 )
 
 import qualified Data.Map.Strict as Map
-import Data.Set (Set)
-import qualified Data.Set as S
 import qualified Data.Sequence as Seq
 
 import System.Directory
@@ -604,7 +603,7 @@ setSessionDynFlags dflags0 = do
   logger <- getLogger
   dflags <- checkNewDynFlags logger dflags0
   let all_uids = hsc_all_home_unit_ids hsc_env
-  case S.toList all_uids of
+  case uniqDSetToList all_uids of
     [uid] -> do
       setUnitDynFlagsNoCheck uid dflags
       modifySession (hscUpdateLoggerFlags . hscSetActiveUnitId (homeUnitId_ dflags))
@@ -1379,7 +1378,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 `S.member` hsc_all_home_unit_ids hsc_env
+  if moduleUnitId mdl `elementOfUniqDSet` hsc_all_home_unit_ids hsc_env
         then liftIO $ getHomeModuleInfo hsc_env mdl
         else liftIO $ getPackageModuleInfo hsc_env mdl
 
@@ -1756,7 +1755,7 @@ isModuleTrusted m = withSession $ \hsc_env ->
     liftIO $ hscCheckSafe hsc_env m noSrcSpan
 
 -- | Return if a module is trusted and the pkgs it depends on to be trusted.
-moduleTrustReqs :: GhcMonad m => Module -> m (Bool, Set UnitId)
+moduleTrustReqs :: GhcMonad m => Module -> m (Bool, UnitIdSet)
 moduleTrustReqs m = withSession $ \hsc_env ->
     liftIO $ hscGetSafe hsc_env m noSrcSpan
 


=====================================
compiler/GHC/Driver/Pipeline.hs
=====================================
@@ -126,7 +126,6 @@ import Control.Monad
 import qualified Control.Monad.Catch as MC (handle)
 import Data.Maybe
 import Data.Either      ( partitionEithers )
-import qualified Data.Set as Set
 
 import Data.Time        ( getCurrentTime )
 import GHC.Iface.Recomp


=====================================
compiler/GHC/HsToCore/Usage.hs
=====================================
@@ -41,7 +41,6 @@ import Data.IORef
 import Data.List (sortBy)
 import Data.Map (Map)
 import qualified Data.Map as Map
-import qualified Data.Set as Set
 
 import GHC.Linker.Types
 import GHC.Unit.Finder


=====================================
ghc/GHCi/UI.hs
=====================================
@@ -105,6 +105,7 @@ import GHC.Utils.Misc
 import qualified GHC.LanguageExtensions as LangExt
 import GHC.Data.Bag (unitBag)
 import qualified GHC.Data.Strict as Strict
+import GHC.Types.Unique.DSet
 
 -- Haskell Libraries
 import System.Console.Haskeline as Haskeline
@@ -169,6 +170,7 @@ import GHC.TopHandler ( topHandler )
 
 import GHCi.Leak
 import qualified GHC.Unit.Module.Graph as GHC
+import GHC.Types.Unique.DSet (isEmptyUniqDSet)
 
 -----------------------------------------------------------------------------
 
@@ -2568,15 +2570,15 @@ isSafeModule m = do
     -- print info to user...
     liftIO $ putStrLn $ "Trust type is (Module: " ++ trust ++ ", Package: " ++ pkg ++ ")"
     liftIO $ putStrLn $ "Package Trust: " ++ (if packageTrustOn dflags then "On" else "Off")
-    when (not $ S.null good)
+    when (not $ isEmptyUniqDSet good)
          (liftIO $ putStrLn $ "Trusted package dependencies (trusted): " ++
-                        (intercalate ", " $ map (showPpr dflags) (S.toList good)))
-    case msafe && S.null bad of
+                        (intercalate ", " $ map (showPpr dflags) (uniqDSetToList good)))
+    case msafe && isEmptyUniqDSet bad of
         True -> liftIO $ putStrLn $ mname ++ " is trusted!"
         False -> do
             when (not $ null bad)
                  (liftIO $ putStrLn $ "Trusted package dependencies (untrusted): "
-                            ++ (intercalate ", " $ map (showPpr dflags) (S.toList bad)))
+                            ++ (intercalate ", " $ map (showPpr dflags) (uniqDSetToList bad)))
             liftIO $ putStrLn $ mname ++ " is NOT trusted!"
 
   where
@@ -2586,8 +2588,8 @@ isSafeModule m = do
         | isHomeModule (hsc_home_unit hsc_env) md = True
         | otherwise = unitIsTrusted $ unsafeLookupUnit (hsc_units hsc_env) (moduleUnit md)
 
-    tallyPkgs hsc_env deps | not (packageTrustOn dflags) = (S.empty, S.empty)
-                          | otherwise = S.partition part deps
+    tallyPkgs hsc_env deps | not (packageTrustOn dflags) = (emptyUniqDSet, emptyUniqDSet)
+                          | otherwise = partitionUniqDSet part deps
         where part pkg   = unitIsTrusted $ unsafeLookupUnitId unit_state pkg
               unit_state = hsc_units hsc_env
               dflags     = hsc_dflags hsc_env



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b7666f0e3fc639d4e383d1d10e3263464b404779
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/20230425/92bb34ee/attachment-0001.html>