Hannes Siebenhandl pushed to branch wip/fendor/ghci-multiple-home-units at Glasgow Haskell Compiler / GHC

Commits:

21 changed files:

Changes:

  • compiler/GHC.hs
    ... ... @@ -38,7 +38,9 @@ module GHC (
    38 38
             setSessionDynFlags,
    
    39 39
             setUnitDynFlags,
    
    40 40
             getProgramDynFlags, setProgramDynFlags,
    
    41
    +        setProgramHUG, setProgramHUG_,
    
    41 42
             getInteractiveDynFlags, setInteractiveDynFlags,
    
    43
    +        normaliseInteractiveDynFlags, initialiseInteractiveDynFlags,
    
    42 44
             interpretPackageEnv,
    
    43 45
     
    
    44 46
             -- * Logging
    
    ... ... @@ -55,6 +57,7 @@ module GHC (
    55 57
             addTarget,
    
    56 58
             removeTarget,
    
    57 59
             guessTarget,
    
    60
    +        guessTargetId,
    
    58 61
     
    
    59 62
             -- * Loading\/compiling the program
    
    60 63
             depanal, depanalE,
    
    ... ... @@ -83,6 +86,7 @@ module GHC (
    83 86
             getModuleGraph,
    
    84 87
             isLoaded,
    
    85 88
             isLoadedModule,
    
    89
    +        isLoadedHomeModule,
    
    86 90
             topSortModuleGraph,
    
    87 91
     
    
    88 92
             -- * Inspecting modules
    
    ... ... @@ -155,6 +159,7 @@ module GHC (
    155 159
             getBindings, getInsts, getNamePprCtx,
    
    156 160
             findModule, lookupModule,
    
    157 161
             findQualifiedModule, lookupQualifiedModule,
    
    162
    +        lookupLoadedHomeModuleByModuleName, lookupAllQualifiedModuleNames,
    
    158 163
             renamePkgQualM, renameRawPkgQualM,
    
    159 164
             isModuleTrusted, moduleTrustReqs,
    
    160 165
             getNamesInScope,
    
    ... ... @@ -443,6 +448,7 @@ import Control.Concurrent
    443 448
     import Control.Monad
    
    444 449
     import Control.Monad.Catch as MC
    
    445 450
     import Data.Foldable
    
    451
    +import Data.Function ((&))
    
    446 452
     import Data.IORef
    
    447 453
     import Data.List (isPrefixOf)
    
    448 454
     import Data.Typeable    ( Typeable )
    
    ... ... @@ -458,7 +464,7 @@ import System.Environment ( getEnv, getProgName )
    458 464
     import System.Exit      ( exitWith, ExitCode(..) )
    
    459 465
     import System.FilePath
    
    460 466
     import System.IO.Error  ( isDoesNotExistError )
    
    461
    -import GHC.Unit.Home.PackageTable
    
    467
    +
    
    462 468
     
    
    463 469
     -- %************************************************************************
    
    464 470
     -- %*                                                                      *
    
    ... ... @@ -861,6 +867,113 @@ setProgramDynFlags_ invalidate_needed dflags = do
    861 867
       when invalidate_needed $ invalidateModSummaryCache
    
    862 868
       return changed
    
    863 869
     
    
    870
    +-- | Sets the program 'HomeUnitGraph'.
    
    871
    +--
    
    872
    +-- Sets the given 'HomeUnitGraph' as the 'HomeUnitGraph' of the current
    
    873
    +-- session. If the package flags change, we reinitialise the 'UnitState'
    
    874
    +-- of all 'HomeUnitEnv's in the current session.
    
    875
    +--
    
    876
    +-- This function unconditionally invalidates the module graph cache.
    
    877
    +--
    
    878
    +-- Precondition: the given 'HomeUnitGraph' must have the same keys as the 'HomeUnitGraph'
    
    879
    +-- of the current session. I.e., assuming the new 'HomeUnitGraph' is called
    
    880
    +-- 'new_hug', then:
    
    881
    +--
    
    882
    +-- @
    
    883
    +--  do
    
    884
    +--    hug <- hsc_HUG \<$\> getSession
    
    885
    +--    pure $ unitEnv_keys new_hug == unitEnv_keys hug
    
    886
    +-- @
    
    887
    +--
    
    888
    +-- If this precondition is violated, the function will crash.
    
    889
    +--
    
    890
    +-- Conceptually, similar to 'setProgramDynFlags', but performs the same check
    
    891
    +-- for all 'HomeUnitEnv's.
    
    892
    +setProgramHUG :: GhcMonad m => HomeUnitGraph -> m Bool
    
    893
    +setProgramHUG =
    
    894
    +  setProgramHUG_ True
    
    895
    +
    
    896
    +-- | Same as 'setProgramHUG', but gives you control over whether you want to
    
    897
    +-- invalidate the module graph cache.
    
    898
    +setProgramHUG_ :: GhcMonad m => Bool -> HomeUnitGraph -> m Bool
    
    899
    +setProgramHUG_ invalidate_needed new_hug0 = do
    
    900
    +  logger <- getLogger
    
    901
    +
    
    902
    +  hug0 <- hsc_HUG <$> getSession
    
    903
    +  (changed, new_hug1) <- checkNewHugDynFlags logger hug0 new_hug0
    
    904
    +
    
    905
    +  if changed
    
    906
    +    then do
    
    907
    +      unit_env0 <- hsc_unit_env <$> getSession
    
    908
    +      home_unit_graph <- HUG.unitEnv_traverseWithKey
    
    909
    +        (updateHomeUnit logger unit_env0 new_hug1)
    
    910
    +        (ue_home_unit_graph unit_env0)
    
    911
    +
    
    912
    +      let dflags1 = homeUnitEnv_dflags $ HUG.unitEnv_lookup (ue_currentUnit unit_env0) home_unit_graph
    
    913
    +      let unit_env = UnitEnv
    
    914
    +            { ue_platform        = targetPlatform dflags1
    
    915
    +            , ue_namever         = ghcNameVersion dflags1
    
    916
    +            , ue_home_unit_graph = home_unit_graph
    
    917
    +            , ue_current_unit    = ue_currentUnit unit_env0
    
    918
    +            , ue_eps             = ue_eps unit_env0
    
    919
    +            }
    
    920
    +      modifySession $ \h ->
    
    921
    +        -- hscSetFlags takes care of updating the logger as well.
    
    922
    +        hscSetFlags dflags1 h{ hsc_unit_env = unit_env }
    
    923
    +    else do
    
    924
    +      modifySession (\env ->
    
    925
    +        env
    
    926
    +          -- Set the new 'HomeUnitGraph'.
    
    927
    +          & hscUpdateHUG (const new_hug1)
    
    928
    +          -- hscSetActiveUnitId makes sure that the 'hsc_dflags'
    
    929
    +          -- are up-to-date.
    
    930
    +          & hscSetActiveUnitId (hscActiveUnitId env)
    
    931
    +          -- Make sure the logger is also updated.
    
    932
    +          & hscUpdateLoggerFlags)
    
    933
    +
    
    934
    +  when invalidate_needed $ invalidateModSummaryCache
    
    935
    +  pure changed
    
    936
    +  where
    
    937
    +    checkNewHugDynFlags :: GhcMonad m => Logger -> HomeUnitGraph -> HomeUnitGraph -> m (Bool, HomeUnitGraph)
    
    938
    +    checkNewHugDynFlags logger old_hug new_hug = do
    
    939
    +      -- Traverse the new HUG and check its 'DynFlags'.
    
    940
    +      -- The old 'HUG' is used to check whether package flags have changed.
    
    941
    +      hugWithCheck <- HUG.unitEnv_traverseWithKey
    
    942
    +        (\unitId homeUnit -> do
    
    943
    +          let newFlags = homeUnitEnv_dflags homeUnit
    
    944
    +              oldFlags = homeUnitEnv_dflags (HUG.unitEnv_lookup unitId old_hug)
    
    945
    +          checkedFlags <- checkNewDynFlags logger newFlags
    
    946
    +          pure
    
    947
    +            ( packageFlagsChanged oldFlags checkedFlags
    
    948
    +            , homeUnit { homeUnitEnv_dflags = checkedFlags }
    
    949
    +            )
    
    950
    +        )
    
    951
    +        new_hug
    
    952
    +      let
    
    953
    +        -- Did any of the package flags change?
    
    954
    +        changed = or $ fmap fst hugWithCheck
    
    955
    +        hug = fmap snd hugWithCheck
    
    956
    +      pure (changed, hug)
    
    957
    +
    
    958
    +    updateHomeUnit :: GhcMonad m => Logger -> UnitEnv -> HomeUnitGraph -> (UnitId -> HomeUnitEnv -> m HomeUnitEnv)
    
    959
    +    updateHomeUnit logger unit_env updates = \uid homeUnitEnv -> do
    
    960
    +      let cached_unit_dbs = homeUnitEnv_unit_dbs homeUnitEnv
    
    961
    +          dflags = case HUG.unitEnv_lookup_maybe uid updates of
    
    962
    +            Nothing -> homeUnitEnv_dflags homeUnitEnv
    
    963
    +            Just env -> homeUnitEnv_dflags env
    
    964
    +          old_hpt = homeUnitEnv_hpt homeUnitEnv
    
    965
    +          home_units = HUG.allUnits (ue_home_unit_graph unit_env)
    
    966
    +
    
    967
    +      (dbs,unit_state,home_unit,mconstants) <- liftIO $ initUnits logger dflags cached_unit_dbs home_units
    
    968
    +
    
    969
    +      updated_dflags <- liftIO $ updatePlatformConstants dflags mconstants
    
    970
    +      pure HomeUnitEnv
    
    971
    +        { homeUnitEnv_units = unit_state
    
    972
    +        , homeUnitEnv_unit_dbs = Just dbs
    
    973
    +        , homeUnitEnv_dflags = updated_dflags
    
    974
    +        , homeUnitEnv_hpt = old_hpt
    
    975
    +        , homeUnitEnv_home_unit = Just home_unit
    
    976
    +        }
    
    864 977
     
    
    865 978
     -- When changing the DynFlags, we want the changes to apply to future
    
    866 979
     -- loads, but without completely discarding the program.  But the
    
    ... ... @@ -900,24 +1013,8 @@ getProgramDynFlags = getSessionDynFlags
    900 1013
     setInteractiveDynFlags :: GhcMonad m => DynFlags -> m ()
    
    901 1014
     setInteractiveDynFlags dflags = do
    
    902 1015
       logger <- getLogger
    
    903
    -  dflags' <- checkNewDynFlags logger dflags
    
    904
    -  dflags'' <- checkNewInteractiveDynFlags logger dflags'
    
    905
    -  modifySessionM $ \hsc_env0 -> do
    
    906
    -    let ic0 = hsc_IC hsc_env0
    
    907
    -
    
    908
    -    -- Initialise (load) plugins in the interactive environment with the new
    
    909
    -    -- DynFlags
    
    910
    -    plugin_env <- liftIO $ initializePlugins $ mkInteractiveHscEnv $
    
    911
    -                    hsc_env0 { hsc_IC = ic0 { ic_dflags = dflags'' }}
    
    912
    -
    
    913
    -    -- Update both plugins cache and DynFlags in the interactive context.
    
    914
    -    return $ hsc_env0
    
    915
    -                { hsc_IC = ic0
    
    916
    -                    { ic_plugins = hsc_plugins plugin_env
    
    917
    -                    , ic_dflags  = hsc_dflags  plugin_env
    
    918
    -                    }
    
    919
    -                }
    
    920
    -
    
    1016
    +  icdflags <- normaliseInteractiveDynFlags logger dflags
    
    1017
    +  modifySessionM (initialiseInteractiveDynFlags icdflags)
    
    921 1018
     
    
    922 1019
     -- | Get the 'DynFlags' used to evaluate interactive expressions.
    
    923 1020
     getInteractiveDynFlags :: GhcMonad m => m DynFlags
    
    ... ... @@ -1022,6 +1119,36 @@ normalise_hyp fp
    1022 1119
     
    
    1023 1120
     -----------------------------------------------------------------------------
    
    1024 1121
     
    
    1122
    +-- | Normalise the 'DynFlags' for us in an interactive context.
    
    1123
    +--
    
    1124
    +-- Makes sure unsupported Flags and other incosistencies are reported and removed.
    
    1125
    +normaliseInteractiveDynFlags :: MonadIO m => Logger -> DynFlags -> m DynFlags
    
    1126
    +normaliseInteractiveDynFlags logger dflags = do
    
    1127
    +  dflags' <- checkNewDynFlags logger dflags
    
    1128
    +  checkNewInteractiveDynFlags logger dflags'
    
    1129
    +
    
    1130
    +-- | Given a set of normalised 'DynFlags' (see 'normaliseInteractiveDynFlags')
    
    1131
    +-- for the interactive context, initialize the 'InteractiveContext'.
    
    1132
    +--
    
    1133
    +-- Initialized plugins and sets the 'DynFlags' as the 'ic_dflags' of the
    
    1134
    +-- 'InteractiveContext'.
    
    1135
    +initialiseInteractiveDynFlags :: GhcMonad m => DynFlags -> HscEnv -> m HscEnv
    
    1136
    +initialiseInteractiveDynFlags dflags hsc_env0 = do
    
    1137
    +  let ic0 = hsc_IC hsc_env0
    
    1138
    +
    
    1139
    +  -- Initialise (load) plugins in the interactive environment with the new
    
    1140
    +  -- DynFlags
    
    1141
    +  plugin_env <- liftIO $ initializePlugins $ mkInteractiveHscEnv $
    
    1142
    +                  hsc_env0 { hsc_IC = ic0 { ic_dflags = dflags }}
    
    1143
    +
    
    1144
    +  -- Update both plugins cache and DynFlags in the interactive context.
    
    1145
    +  return $ hsc_env0
    
    1146
    +              { hsc_IC = ic0
    
    1147
    +                  { ic_plugins = hsc_plugins plugin_env
    
    1148
    +                  , ic_dflags  = hsc_dflags  plugin_env
    
    1149
    +                  }
    
    1150
    +              }
    
    1151
    +
    
    1025 1152
     -- | Checks the set of new DynFlags for possibly erroneous option
    
    1026 1153
     -- combinations when invoking 'setSessionDynFlags' and friends, and if
    
    1027 1154
     -- found, returns a fixed copy (if possible).
    
    ... ... @@ -1084,7 +1211,7 @@ removeTarget target_id
    1084 1211
       where
    
    1085 1212
        filter targets = [ t | t@Target { targetId = id } <- targets, id /= target_id ]
    
    1086 1213
     
    
    1087
    --- | Attempts to guess what Target a string refers to.  This function
    
    1214
    +-- | Attempts to guess what 'Target' a string refers to.  This function
    
    1088 1215
     -- implements the @--make@/GHCi command-line syntax for filenames:
    
    1089 1216
     --
    
    1090 1217
     --   - if the string looks like a Haskell source filename, then interpret it
    
    ... ... @@ -1093,27 +1220,52 @@ removeTarget target_id
    1093 1220
     --   - if adding a .hs or .lhs suffix yields the name of an existing file,
    
    1094 1221
     --     then use that
    
    1095 1222
     --
    
    1096
    ---   - otherwise interpret the string as a module name
    
    1223
    +--   - If it looks like a module name, interpret it as such
    
    1097 1224
     --
    
    1225
    +--   - otherwise, this function throws a 'GhcException'.
    
    1098 1226
     guessTarget :: GhcMonad m => String -> Maybe UnitId -> Maybe Phase -> m Target
    
    1099 1227
     guessTarget str mUnitId (Just phase)
    
    1100 1228
        = do
    
    1101 1229
          tuid <- unitIdOrHomeUnit mUnitId
    
    1102 1230
          return (Target (TargetFile str (Just phase)) True tuid Nothing)
    
    1103
    -guessTarget str mUnitId Nothing
    
    1231
    +guessTarget str mUnitId Nothing = do
    
    1232
    +  targetId <- guessTargetId str
    
    1233
    +  toTarget targetId
    
    1234
    +     where
    
    1235
    +         obj_allowed
    
    1236
    +                | '*':_ <- str = False
    
    1237
    +                | otherwise    = True
    
    1238
    +         toTarget tid = do
    
    1239
    +           tuid <- unitIdOrHomeUnit mUnitId
    
    1240
    +           pure $ Target tid obj_allowed tuid Nothing
    
    1241
    +
    
    1242
    +-- | Attempts to guess what 'TargetId' a string refers to.  This function
    
    1243
    +-- implements the @--make@/GHCi command-line syntax for filenames:
    
    1244
    +--
    
    1245
    +--   - if the string looks like a Haskell source filename, then interpret it
    
    1246
    +--     as such
    
    1247
    +--
    
    1248
    +--   - if adding a .hs or .lhs suffix yields the name of an existing file,
    
    1249
    +--     then use that
    
    1250
    +--
    
    1251
    +--   - If it looks like a module name, interpret it as such
    
    1252
    +--
    
    1253
    +--   - otherwise, this function throws a 'GhcException'.
    
    1254
    +guessTargetId :: GhcMonad m => String -> m TargetId
    
    1255
    +guessTargetId str
    
    1104 1256
        | isHaskellSrcFilename file
    
    1105
    -   = target (TargetFile file Nothing)
    
    1257
    +   = pure (TargetFile file Nothing)
    
    1106 1258
        | otherwise
    
    1107 1259
        = do exists <- liftIO $ doesFileExist hs_file
    
    1108 1260
             if exists
    
    1109
    -           then target (TargetFile hs_file Nothing)
    
    1261
    +           then pure (TargetFile hs_file Nothing)
    
    1110 1262
                else do
    
    1111 1263
             exists <- liftIO $ doesFileExist lhs_file
    
    1112 1264
             if exists
    
    1113
    -           then target (TargetFile lhs_file Nothing)
    
    1265
    +           then pure (TargetFile lhs_file Nothing)
    
    1114 1266
                else do
    
    1115 1267
             if looksLikeModuleName file
    
    1116
    -           then target (TargetModule (mkModuleName file))
    
    1268
    +           then pure (TargetModule (mkModuleName file))
    
    1117 1269
                else do
    
    1118 1270
             dflags <- getDynFlags
    
    1119 1271
             liftIO $ throwGhcExceptionIO
    
    ... ... @@ -1121,16 +1273,12 @@ guessTarget str mUnitId Nothing
    1121 1273
                      text "target" <+> quotes (text file) <+>
    
    1122 1274
                      text "is not a module name or a source file"))
    
    1123 1275
          where
    
    1124
    -         (file,obj_allowed)
    
    1125
    -                | '*':rest <- str = (rest, False)
    
    1126
    -                | otherwise       = (str,  True)
    
    1276
    +        file
    
    1277
    +          | '*':rest <- str = rest
    
    1278
    +          | otherwise       = str
    
    1127 1279
     
    
    1128
    -         hs_file  = file <.> "hs"
    
    1129
    -         lhs_file = file <.> "lhs"
    
    1130
    -
    
    1131
    -         target tid = do
    
    1132
    -           tuid <- unitIdOrHomeUnit mUnitId
    
    1133
    -           pure $ Target tid obj_allowed tuid Nothing
    
    1280
    +        hs_file  = file <.> "hs"
    
    1281
    +        lhs_file = file <.> "lhs"
    
    1134 1282
     
    
    1135 1283
     -- | Unwrap 'UnitId' or retrieve the 'UnitId'
    
    1136 1284
     -- of the current 'HomeUnit'.
    
    ... ... @@ -1251,11 +1399,11 @@ type TypecheckedSource = LHsBinds GhcTc
    1251 1399
     --
    
    1252 1400
     -- This function ignores boot modules and requires that there is only one
    
    1253 1401
     -- non-boot module with the given name.
    
    1254
    -getModSummary :: GhcMonad m => ModuleName -> m ModSummary
    
    1402
    +getModSummary :: GhcMonad m => Module -> m ModSummary
    
    1255 1403
     getModSummary mod = do
    
    1256 1404
        mg <- liftM hsc_mod_graph getSession
    
    1257 1405
        let mods_by_name = [ ms | ms <- mgModSummaries mg
    
    1258
    -                      , ms_mod_name ms == mod
    
    1406
    +                      , ms_mod ms == mod
    
    1259 1407
                           , isBootSummary ms == NotBoot ]
    
    1260 1408
        case mods_by_name of
    
    1261 1409
          [] -> do dflags <- getDynFlags
    
    ... ... @@ -1286,7 +1434,9 @@ typecheckModule pmod = do
    1286 1434
      liftIO $ do
    
    1287 1435
        let ms          = modSummary pmod
    
    1288 1436
        let lcl_dflags  = ms_hspp_opts ms -- take into account pragmas (OPTIONS_GHC, etc.)
    
    1289
    -   let lcl_hsc_env = hscSetFlags lcl_dflags hsc_env
    
    1437
    +   let lcl_hsc_env =
    
    1438
    +          hscSetFlags lcl_dflags $
    
    1439
    +          hscSetActiveUnitId (toUnitId $ moduleUnit $ ms_mod ms) hsc_env
    
    1290 1440
        let lcl_logger  = hsc_logger lcl_hsc_env
    
    1291 1441
        (tc_gbl_env, rn_info) <- hscTypecheckRename lcl_hsc_env ms $
    
    1292 1442
                             HsParsedModule { hpm_module = parsedSource pmod,
    
    ... ... @@ -1428,17 +1578,28 @@ compileCore simplify fn = do
    1428 1578
     getModuleGraph :: GhcMonad m => m ModuleGraph -- ToDo: DiGraph ModSummary
    
    1429 1579
     getModuleGraph = liftM hsc_mod_graph getSession
    
    1430 1580
     
    
    1581
    +{-# DEPRECATED isLoaded "Prefer 'isLoadedModule' and 'isLoadedHomeModule'" #-}
    
    1431 1582
     -- | Return @True@ \<==> module is loaded.
    
    1432 1583
     isLoaded :: GhcMonad m => ModuleName -> m Bool
    
    1433 1584
     isLoaded m = withSession $ \hsc_env -> liftIO $ do
    
    1434
    -  hmi <- lookupHpt (hsc_HPT hsc_env) m
    
    1435
    -  return $! isJust hmi
    
    1585
    +  hmis <- HUG.lookupAllHug (hsc_HUG hsc_env) m
    
    1586
    +  return $! not (null hmis)
    
    1436 1587
     
    
    1588
    +-- | Check whether a 'ModuleName' is found in the 'HomePackageTable'
    
    1589
    +-- for the given 'UnitId'.
    
    1437 1590
     isLoadedModule :: GhcMonad m => UnitId -> ModuleName -> m Bool
    
    1438 1591
     isLoadedModule uid m = withSession $ \hsc_env -> liftIO $ do
    
    1439 1592
       hmi <- HUG.lookupHug (hsc_HUG hsc_env) uid m
    
    1440 1593
       return $! isJust hmi
    
    1441 1594
     
    
    1595
    +-- | Check whether 'Module' is part of the 'HomeUnitGraph'.
    
    1596
    +--
    
    1597
    +-- Similar to 'isLoadedModule', but for 'Module's.
    
    1598
    +isLoadedHomeModule :: GhcMonad m => Module -> m Bool
    
    1599
    +isLoadedHomeModule m = withSession $ \hsc_env -> liftIO $ do
    
    1600
    +  hmi <- HUG.lookupHugByModule m (hsc_HUG hsc_env)
    
    1601
    +  return $! isJust hmi
    
    1602
    +
    
    1442 1603
     -- | Return the bindings for the current interactive session.
    
    1443 1604
     getBindings :: GhcMonad m => m [TyThing]
    
    1444 1605
     getBindings = withSession $ \hsc_env ->
    
    ... ... @@ -1470,7 +1631,7 @@ data ModuleInfo = ModuleInfo {
    1470 1631
     -- | Request information about a loaded 'Module'
    
    1471 1632
     getModuleInfo :: GhcMonad m => Module -> m (Maybe ModuleInfo)  -- XXX: Maybe X
    
    1472 1633
     getModuleInfo mdl = withSession $ \hsc_env -> do
    
    1473
    -  if moduleUnitId mdl `S.member` hsc_all_home_unit_ids hsc_env
    
    1634
    +  if HUG.memberHugUnit (moduleUnit mdl) (hsc_HUG hsc_env)
    
    1474 1635
             then liftIO $ getHomeModuleInfo hsc_env mdl
    
    1475 1636
             else liftIO $ getPackageModuleInfo hsc_env mdl
    
    1476 1637
     
    
    ... ... @@ -1826,6 +1987,50 @@ lookupLoadedHomeModule uid mod_name = withSession $ \hsc_env -> liftIO $ do
    1826 1987
         Just mod_info      -> return (Just (mi_module (hm_iface mod_info)))
    
    1827 1988
         _not_a_home_module -> return Nothing
    
    1828 1989
     
    
    1990
    +-- | Lookup the given 'ModuleName' in the 'HomeUnitGraph'.
    
    1991
    +--
    
    1992
    +-- Returns 'Nothing' if no 'Module' has the given 'ModuleName'.
    
    1993
    +-- Otherwise, returns all 'Module's that have the given 'ModuleName'.
    
    1994
    +--
    
    1995
    +-- A 'ModuleName' is generally not enough to uniquely identify a 'Module', since
    
    1996
    +-- there can be multiple units exposing the same 'ModuleName' in the case of
    
    1997
    +-- multiple home units.
    
    1998
    +-- Thus, this function may return more than one possible 'Module'.
    
    1999
    +-- We leave it up to the caller to decide how to handle the ambiguity.
    
    2000
    +-- For example, GHCi may prompt the user to clarify which 'Module' is the correct one.
    
    2001
    +--
    
    2002
    +lookupLoadedHomeModuleByModuleName :: GhcMonad m => ModuleName -> m (Maybe [Module])
    
    2003
    +lookupLoadedHomeModuleByModuleName mod_name = withSession $ \hsc_env -> liftIO $ do
    
    2004
    +  trace_if (hsc_logger hsc_env) (text "lookupLoadedHomeModuleByModuleName" <+> ppr mod_name)
    
    2005
    +  HUG.lookupAllHug (hsc_HUG hsc_env) mod_name >>= \case
    
    2006
    +    []        -> return Nothing
    
    2007
    +    mod_infos -> return (Just (mi_module . hm_iface <$> mod_infos))
    
    2008
    +
    
    2009
    +-- | Given a 'ModuleName' and 'PkgQual', lookup all 'Module's that may fit the criteria.
    
    2010
    +--
    
    2011
    +-- Identically to 'lookupLoadedHomeModuleByModuleName', there may be more than one
    
    2012
    +-- 'Module' in the 'HomeUnitGraph' that has the given 'ModuleName'.
    
    2013
    +--
    
    2014
    +-- The result is guaranteed to be non-empty, if no 'Module' can be found,
    
    2015
    +-- this function throws an error.
    
    2016
    +lookupAllQualifiedModuleNames :: GhcMonad m => PkgQual -> ModuleName -> m [Module]
    
    2017
    +lookupAllQualifiedModuleNames NoPkgQual mod_name = withSession $ \hsc_env -> do
    
    2018
    +  home <- lookupLoadedHomeModuleByModuleName mod_name
    
    2019
    +  case home of
    
    2020
    +    Just m  -> return m
    
    2021
    +    Nothing -> liftIO $ do
    
    2022
    +      let fc     = hsc_FC hsc_env
    
    2023
    +      let units  = hsc_units hsc_env
    
    2024
    +      let dflags = hsc_dflags hsc_env
    
    2025
    +      let fopts  = initFinderOpts dflags
    
    2026
    +      res <- findExposedPackageModule fc fopts units mod_name NoPkgQual
    
    2027
    +      case res of
    
    2028
    +        Found _ m -> return [m]
    
    2029
    +        err       -> throwOneError $ noModError hsc_env noSrcSpan mod_name err
    
    2030
    +lookupAllQualifiedModuleNames pkgqual mod_name = do
    
    2031
    +  m <- findQualifiedModule pkgqual mod_name
    
    2032
    +  pure [m]
    
    2033
    +
    
    1829 2034
     -- | Check that a module is safe to import (according to Safe Haskell).
    
    1830 2035
     --
    
    1831 2036
     -- We return True to indicate the import is safe and False otherwise
    

  • compiler/GHC/Driver/Downsweep.hs
    ... ... @@ -277,11 +277,20 @@ downsweepInteractiveImports hsc_env ic = unsafeInterleaveIO $ do
    277 277
     
    
    278 278
       where
    
    279 279
      --
    
    280
    -    mkEdge :: InteractiveImport -> (UnitId, ImportLevel, PkgQual, GenWithIsBoot (Located ModuleName))
    
    280
    +    mkEdge :: InteractiveImport -> Either ModuleNodeEdge (UnitId, ImportLevel, PkgQual, GenWithIsBoot (Located ModuleName))
    
    281 281
         -- A simple edge to a module from the same home unit
    
    282 282
         mkEdge (IIModule n) =
    
    283
    -      let unitId = homeUnitId $ hsc_home_unit hsc_env
    
    284
    -      in (unitId, NormalLevel, NoPkgQual, GWIB (noLoc n) NotBoot)
    
    283
    +      let
    
    284
    +        mod_node_key = ModNodeKeyWithUid
    
    285
    +          { mnkModuleName = GWIB (moduleName n) NotBoot
    
    286
    +          , mnkUnitId =
    
    287
    +              -- 'toUnitId' is safe here, as we can't import modules that
    
    288
    +              -- don't have a 'UnitId'.
    
    289
    +              toUnitId (moduleUnit n)
    
    290
    +          }
    
    291
    +        mod_node_edge =
    
    292
    +          ModuleNodeEdge NormalLevel (NodeKey_Module mod_node_key)
    
    293
    +      in Left mod_node_edge
    
    285 294
         -- A complete import statement
    
    286 295
         mkEdge (IIDecl i) =
    
    287 296
           let lvl = convImportLevel (ideclLevelSpec i)
    
    ... ... @@ -289,37 +298,41 @@ downsweepInteractiveImports hsc_env ic = unsafeInterleaveIO $ do
    289 298
               is_boot = ideclSource i
    
    290 299
               mb_pkg = renameRawPkgQual (hsc_unit_env hsc_env) (unLoc $ ideclName i) (ideclPkgQual i)
    
    291 300
               unitId = homeUnitId $ hsc_home_unit hsc_env
    
    292
    -      in (unitId, lvl, mb_pkg, GWIB (noLoc wanted_mod) is_boot)
    
    301
    +      in Right (unitId, lvl, mb_pkg, GWIB (noLoc wanted_mod) is_boot)
    
    293 302
     
    
    294 303
     loopFromInteractive :: HscEnv
    
    295
    -                    -> [(UnitId, ImportLevel, PkgQual, GenWithIsBoot (Located ModuleName))]
    
    304
    +                    -> [Either ModuleNodeEdge (UnitId, ImportLevel, PkgQual, GenWithIsBoot (Located ModuleName))]
    
    296 305
                         -> M.Map NodeKey ModuleGraphNode
    
    297 306
                         -> IO ([ModuleNodeEdge],M.Map NodeKey ModuleGraphNode)
    
    298 307
     loopFromInteractive _ [] cached_nodes = return ([], cached_nodes)
    
    299
    -loopFromInteractive hsc_env (edge:edges) cached_nodes = do
    
    300
    -  let (unitId, lvl, mb_pkg, GWIB wanted_mod is_boot) = edge
    
    301
    -  let home_unit = ue_unitHomeUnit unitId (hsc_unit_env hsc_env)
    
    302
    -  let k _ loc mod =
    
    303
    -        let key = moduleToMnk mod is_boot
    
    304
    -        in return $ FoundHome (ModuleNodeFixed key loc)
    
    305
    -  found <- liftIO $ summariseModuleDispatch k hsc_env home_unit is_boot wanted_mod mb_pkg []
    
    306
    -  case found of
    
    307
    -    -- Case 1: Home modules have to already be in the cache.
    
    308
    -    FoundHome (ModuleNodeFixed mod _) -> do
    
    309
    -      let edge = ModuleNodeEdge lvl (NodeKey_Module mod)
    
    310
    -      -- Note: Does not perform any further downsweep as the module must already be in the cache.
    
    311
    -      (edges, cached_nodes') <- loopFromInteractive hsc_env edges cached_nodes
    
    312
    -      return (edge : edges, cached_nodes')
    
    313
    -    -- Case 2: External units may not be in the cache, if we haven't already initialised the
    
    314
    -    -- module graph. We can construct the module graph for those here by calling loopUnit.
    
    315
    -    External uid -> do
    
    316
    -      let hsc_env' = hscSetActiveHomeUnit home_unit hsc_env
    
    317
    -          cached_nodes' = loopUnit hsc_env' cached_nodes [uid]
    
    318
    -          edge = ModuleNodeEdge lvl (NodeKey_ExternalUnit uid)
    
    319
    -      (edges, cached_nodes') <- loopFromInteractive hsc_env edges cached_nodes'
    
    320
    -      return (edge : edges, cached_nodes')
    
    321
    -    -- And if it's not found.. just carry on and hope.
    
    322
    -    _ -> loopFromInteractive hsc_env edges cached_nodes
    
    308
    +loopFromInteractive hsc_env (edge:edges) cached_nodes =
    
    309
    +  case edge of
    
    310
    +    Left edge -> do
    
    311
    +        (edges, cached_nodes') <- loopFromInteractive hsc_env edges cached_nodes
    
    312
    +        return (edge : edges, cached_nodes')
    
    313
    +    Right (unitId, lvl, mb_pkg, GWIB wanted_mod is_boot) -> do
    
    314
    +      let home_unit = ue_unitHomeUnit unitId (hsc_unit_env hsc_env)
    
    315
    +      let k _ loc mod =
    
    316
    +            let key = moduleToMnk mod is_boot
    
    317
    +            in return $ FoundHome (ModuleNodeFixed key loc)
    
    318
    +      found <- liftIO $ summariseModuleDispatch k hsc_env home_unit is_boot wanted_mod mb_pkg []
    
    319
    +      case found of
    
    320
    +        -- Case 1: Home modules have to already be in the cache.
    
    321
    +        FoundHome (ModuleNodeFixed mod _) -> do
    
    322
    +          let edge = ModuleNodeEdge lvl (NodeKey_Module mod)
    
    323
    +          -- Note: Does not perform any further downsweep as the module must already be in the cache.
    
    324
    +          (edges, cached_nodes') <- loopFromInteractive hsc_env edges cached_nodes
    
    325
    +          return (edge : edges, cached_nodes')
    
    326
    +        -- Case 2: External units may not be in the cache, if we haven't already initialised the
    
    327
    +        -- module graph. We can construct the module graph for those here by calling loopUnit.
    
    328
    +        External uid -> do
    
    329
    +          let hsc_env' = hscSetActiveHomeUnit home_unit hsc_env
    
    330
    +              cached_nodes' = loopUnit hsc_env' cached_nodes [uid]
    
    331
    +              edge = ModuleNodeEdge lvl (NodeKey_ExternalUnit uid)
    
    332
    +          (edges, cached_nodes') <- loopFromInteractive hsc_env edges cached_nodes'
    
    333
    +          return (edge : edges, cached_nodes')
    
    334
    +        -- And if it's not found.. just carry on and hope.
    
    335
    +        _ -> loopFromInteractive hsc_env edges cached_nodes
    
    323 336
     
    
    324 337
     
    
    325 338
     -- | Create a module graph from a list of installed modules.
    

  • compiler/GHC/Driver/Session.hs
    ... ... @@ -162,6 +162,7 @@ module GHC.Driver.Session (
    162 162
             updOptLevel,
    
    163 163
             setTmpDir,
    
    164 164
             setUnitId,
    
    165
    +        setHomeUnitId,
    
    165 166
     
    
    166 167
             TurnOnFlag,
    
    167 168
             turnOn,
    
    ... ... @@ -3114,6 +3115,9 @@ parseUnitArg =
    3114 3115
     setUnitId :: String -> DynFlags -> DynFlags
    
    3115 3116
     setUnitId p d = d { homeUnitId_ = stringToUnitId p }
    
    3116 3117
     
    
    3118
    +setHomeUnitId :: UnitId -> DynFlags -> DynFlags
    
    3119
    +setHomeUnitId p d = d { homeUnitId_ = p }
    
    3120
    +
    
    3117 3121
     setWorkingDirectory :: String -> DynFlags -> DynFlags
    
    3118 3122
     setWorkingDirectory p d = d { workingDirectory =  Just p }
    
    3119 3123
     
    

  • compiler/GHC/Iface/Load.hs
    ... ... @@ -918,12 +918,10 @@ findAndReadIface hsc_env doc_str mod wanted_mod hi_boot_file = do
    918 918
               case mb_found of
    
    919 919
                   InstalledFound loc -> do
    
    920 920
                       -- See Note [Home module load error]
    
    921
    -                  case mhome_unit of
    
    922
    -                    Just home_unit
    
    923
    -                      | isHomeInstalledModule home_unit mod
    
    924
    -                      , not (isOneShot (ghcMode dflags))
    
    925
    -                      -> return (Failed (HomeModError mod loc))
    
    926
    -                    _ -> do
    
    921
    +                  if HUG.memberHugUnitId (moduleUnit mod) (hsc_HUG hsc_env)
    
    922
    +                      && not (isOneShot (ghcMode dflags))
    
    923
    +                    then return (Failed (HomeModError mod loc))
    
    924
    +                    else do
    
    927 925
                             r <- read_file logger name_cache unit_state dflags wanted_mod (ml_hi_file loc)
    
    928 926
                             case r of
    
    929 927
                               Failed err
    

  • compiler/GHC/Rename/Unbound.hs
    ... ... @@ -364,7 +364,7 @@ importSuggestions looking_for ic currMod imports rdr_name
    364 364
       pick_interactive :: InteractiveImport -> Bool
    
    365 365
       pick_interactive (IIDecl d)   | mod_name == Just (unLoc (ideclName d)) = True
    
    366 366
                                     | mod_name == fmap unLoc (ideclAs d) = True
    
    367
    -  pick_interactive (IIModule m) | mod_name == Just m = True
    
    367
    +  pick_interactive (IIModule m) | mod_name == Just (moduleName m) = True
    
    368 368
       pick_interactive _ = False
    
    369 369
     
    
    370 370
       -- We want to keep only one for each original module; preferably one with an
    

  • compiler/GHC/Runtime/Context.hs
    ... ... @@ -115,6 +115,51 @@ The details are a bit tricky though:
    115 115
       modules.
    
    116 116
     
    
    117 117
     
    
    118
    +Note [Relation between the 'InteractiveContext' and 'interactiveGhciUnitId']
    
    119
    +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    
    120
    +The 'InteractiveContext' is used to store 'DynFlags', 'Plugins' and similar
    
    121
    +information about the so-called interactive "home unit". We are using
    
    122
    +quotes here, since, originally, GHC wasn't aware of more than one 'HomeUnitEnv's.
    
    123
    +So the 'InteractiveContext' was a hack/solution to have 'DynFlags' and 'Plugins'
    
    124
    +independent of the 'DynFlags' and 'Plugins' stored in 'HscEnv'.
    
    125
    +Nowadays, GHC has support for multiple home units via the 'HomeUnitGraph', thus,
    
    126
    +this part of the 'InteractiveContext' is strictly speaking redundant, as we
    
    127
    +can simply manage one 'HomeUnitEnv' for the 'DynFlags' and 'Plugins' that are
    
    128
    +currently stored in the 'InteractiveContext'.
    
    129
    +
    
    130
    +As a matter of fact, that's exactly what we do nowadays.
    
    131
    +That means, we can also lift other restrictions in the future, for example
    
    132
    +allowing @:seti@ commands to modify the package-flags, since we now have a
    
    133
    +separate 'UnitState' for the interactive session.
    
    134
    +However, we did not rip out 'ic_dflags' and 'ic_plugins', yet, as it makes
    
    135
    +it easier to access them for functions that want to use the interactive 'DynFlags',
    
    136
    +such as 'runInteractiveHsc' and 'mkInteractiveHscEnv', without having to look that
    
    137
    +information up in the 'HomeUnitGraph'.
    
    138
    +It is reasonable to change this in the future, and remove 'ic_dflags' and 'ic_plugins'.
    
    139
    +
    
    140
    +We keep 'ic_dflags' and 'ic_plugins' around, but we also store a 'HomeUnitEnv'
    
    141
    +for the 'DynFlags' and 'Plugins' of the interactive session.
    
    142
    +
    
    143
    +It is important to keep the 'DynFlags' in these two places consistent.
    
    144
    +
    
    145
    +In other words, whenever you update the 'DynFlags' of the 'interactiveGhciUnitId'
    
    146
    +in the 'HscEnv', then you also need to update the 'DynFlags' of the
    
    147
    +'InteractiveContext'.
    
    148
    +The easiest way to update them is via 'setInteractiveDynFlags'.
    
    149
    +However, careful, footgun! It is very easy to call 'setInteractiveDynFlags'
    
    150
    +and forget to call 'normaliseInteractiveDynFlags' on the 'DynFlags' in the
    
    151
    +'HscEnv'! This is important, because you may, accidentally, have enabled
    
    152
    +Language Extensions that are not supported in the interactive ghc session,
    
    153
    +which we do not want.
    
    154
    +
    
    155
    +To summarise, the 'ic_dflags' and 'ic_plugins' are currently used to
    
    156
    +conveniently cache them for easy access.
    
    157
    +The 'ic_dflags' must be identical to the 'DynFlags' stored in the 'HscEnv'
    
    158
    +for the 'HomeUnitEnv' identified by 'interactiveGhciUnitId'.
    
    159
    +
    
    160
    +See Note [Multiple Home Units aware GHCi] for the design and rationale for
    
    161
    +the current 'interactiveGhciUnitId'.
    
    162
    +
    
    118 163
     Note [Interactively-bound Ids in GHCi]
    
    119 164
     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    
    120 165
     The Ids bound by previous Stmts in GHCi are currently
    
    ... ... @@ -296,7 +341,7 @@ data InteractiveImport
    296 341
           -- ^ Bring the exports of a particular module
    
    297 342
           -- (filtered by an import decl) into scope
    
    298 343
     
    
    299
    -  | IIModule ModuleName
    
    344
    +  | IIModule Module
    
    300 345
           -- ^ Bring into scope the entire top-level envt of
    
    301 346
           -- of this module, including the things imported
    
    302 347
           -- into it.
    

  • compiler/GHC/Runtime/Eval.hs
    ... ... @@ -119,7 +119,6 @@ import GHC.Unit
    119 119
     import GHC.Unit.Module.Graph
    
    120 120
     import GHC.Unit.Module.ModIface
    
    121 121
     import GHC.Unit.Home.ModInfo
    
    122
    -import GHC.Unit.Home.PackageTable
    
    123 122
     
    
    124 123
     import GHC.Tc.Module ( runTcInteractive, tcRnTypeSkolemising, loadUnqualIfaces )
    
    125 124
     import GHC.Tc.Solver (simplifyWantedsTcM)
    
    ... ... @@ -823,16 +822,17 @@ findGlobalRdrEnv hsc_env imports
    823 822
         idecls :: [LImportDecl GhcPs]
    
    824 823
         idecls = [noLocA d | IIDecl d <- imports]
    
    825 824
     
    
    826
    -    imods :: [ModuleName]
    
    825
    +    imods :: [Module]
    
    827 826
         imods = [m | IIModule m <- imports]
    
    828 827
     
    
    829
    -    mkEnv mod = mkTopLevEnv hsc_env mod >>= \case
    
    830
    -      Left err -> pure $ Left (mod, err)
    
    831
    -      Right env -> pure $ Right env
    
    828
    +    mkEnv mod = do
    
    829
    +      mkTopLevEnv hsc_env mod >>= \case
    
    830
    +        Left err -> pure $ Left (moduleName mod, err)
    
    831
    +        Right env -> pure $ Right env
    
    832 832
     
    
    833
    -mkTopLevEnv :: HscEnv -> ModuleName -> IO (Either String GlobalRdrEnv)
    
    833
    +mkTopLevEnv :: HscEnv -> Module -> IO (Either String GlobalRdrEnv)
    
    834 834
     mkTopLevEnv hsc_env modl
    
    835
    -  = lookupHpt hpt modl >>= \case
    
    835
    +  = HUG.lookupHugByModule modl hug >>= \case
    
    836 836
           Nothing -> pure $ Left "not a home module"
    
    837 837
           Just details ->
    
    838 838
              case mi_top_env (hm_iface details) of
    
    ... ... @@ -841,7 +841,7 @@ mkTopLevEnv hsc_env modl
    841 841
                       let exports_env = mkGlobalRdrEnv $ gresFromAvails hsc_env Nothing (getDetOrdAvails exports)
    
    842 842
                       pure $ Right $ plusGlobalRdrEnv imports_env exports_env
    
    843 843
       where
    
    844
    -    hpt = hsc_HPT hsc_env
    
    844
    +    hug = hsc_HUG hsc_env
    
    845 845
     
    
    846 846
     -- | Make the top-level environment with all bindings imported by this module.
    
    847 847
     -- Exported bindings from this module are not included in the result.
    
    ... ... @@ -877,11 +877,9 @@ getContext = withSession $ \HscEnv{ hsc_IC=ic } ->
    877 877
     -- its full top-level scope available.
    
    878 878
     moduleIsInterpreted :: GhcMonad m => Module -> m Bool
    
    879 879
     moduleIsInterpreted modl = withSession $ \h ->
    
    880
    - if notHomeModule (hsc_home_unit h) modl
    
    881
    -        then return False
    
    882
    -        else liftIO (HUG.lookupHugByModule modl (hsc_HUG h)) >>= \case
    
    883
    -              Just hmi       -> return (isJust $ homeModInfoByteCode hmi)
    
    884
    -              _not_a_home_module -> return False
    
    880
    +  liftIO (HUG.lookupHugByModule modl (hsc_HUG h)) >>= \case
    
    881
    +    Just hmi           -> return (isJust $ homeModInfoByteCode hmi)
    
    882
    +    _not_a_home_module -> return False
    
    885 883
     
    
    886 884
     -- | Looks up an identifier in the current interactive context (for :info)
    
    887 885
     -- Filter the instances by the ones whose tycons (or classes resp)
    

  • compiler/GHC/StgToByteCode.hs
    ... ... @@ -77,7 +77,7 @@ import Control.Monad
    77 77
     import Data.Char
    
    78 78
     
    
    79 79
     import GHC.Unit.Module
    
    80
    -import GHC.Unit.Home.PackageTable (lookupHpt)
    
    80
    +import qualified GHC.Unit.Home.Graph as HUG
    
    81 81
     
    
    82 82
     import Data.Array
    
    83 83
     import Data.Coerce (coerce)
    
    ... ... @@ -436,8 +436,7 @@ schemeER_wrk d p rhs = schemeE d 0 p rhs
    436 436
     -- If that is 'Nothing', consider breakpoints to be disabled and skip the
    
    437 437
     -- instruction.
    
    438 438
     --
    
    439
    --- If the breakpoint is inlined from another module, look it up in the home
    
    440
    --- package table.
    
    439
    +-- If the breakpoint is inlined from another module, look it up in the HUG (home unit graph).
    
    441 440
     -- If the module doesn't exist there, or its module pointer is null (which means
    
    442 441
     -- that the 'ModBreaks' value is uninitialized), skip the instruction.
    
    443 442
     break_info ::
    
    ... ... @@ -450,7 +449,7 @@ break_info hsc_env mod current_mod current_mod_breaks
    450 449
       | mod == current_mod
    
    451 450
       = pure $ check_mod_ptr =<< current_mod_breaks
    
    452 451
       | otherwise
    
    453
    -  = ioToBc (lookupHpt (hsc_HPT hsc_env) (moduleName mod)) >>= \case
    
    452
    +  = ioToBc (HUG.lookupHugByModule mod (hsc_HUG hsc_env)) >>= \case
    
    454 453
           Just hp -> pure $ check_mod_ptr (getModBreaks hp)
    
    455 454
           Nothing -> pure Nothing
    
    456 455
       where
    

  • compiler/GHC/StgToJS/Linker/Linker.hs
    ... ... @@ -461,7 +461,7 @@ computeLinkDependencies cfg unit_env link_spec finder_opts finder_cache ar_cache
    461 461
     
    
    462 462
       -- all the units we want to link together, without their dependencies
    
    463 463
       let root_units = filter (/= ue_currentUnit unit_env)
    
    464
    -                   $ filter (/= interactiveUnitId)
    
    464
    +                   $ filter (/= interactiveUnitId) -- TODO @fendor: what does this do?
    
    465 465
                        $ nub
    
    466 466
                        $ rts_wired_units ++ reverse obj_units ++ reverse units
    
    467 467
     
    

  • compiler/GHC/Tc/Module.hs
    ... ... @@ -150,7 +150,6 @@ import GHC.Types.Basic hiding( SuccessFlag(..) )
    150 150
     import GHC.Types.Annotations
    
    151 151
     import GHC.Types.SrcLoc
    
    152 152
     import GHC.Types.SourceFile
    
    153
    -import GHC.Types.PkgQual
    
    154 153
     import qualified GHC.LanguageExtensions as LangExt
    
    155 154
     
    
    156 155
     import GHC.Unit.Env as UnitEnv
    
    ... ... @@ -2119,15 +2118,18 @@ runTcInteractive hsc_env thing_inside
    2119 2118
                                                      , let local_gres = filter isLocalGRE gres
    
    2120 2119
                                                      , not (null local_gres) ]) ]
    
    2121 2120
     
    
    2122
    -       ; let getOrphans m mb_pkg = fmap (\iface -> mi_module iface
    
    2123
    -                                          : dep_orphs (mi_deps iface))
    
    2124
    -                                 (loadSrcInterface (text "runTcInteractive") m
    
    2125
    -                                                   NotBoot mb_pkg)
    
    2121
    +       ; let getOrphansForModuleName m mb_pkg = do
    
    2122
    +              iface <- loadSrcInterface (text "runTcInteractive") m NotBoot mb_pkg
    
    2123
    +              pure $ mi_module iface : dep_orphs (mi_deps iface)
    
    2124
    +
    
    2125
    +             getOrphansForModule m = do
    
    2126
    +              iface <- loadModuleInterface (text "runTcInteractive") m
    
    2127
    +              pure $ mi_module iface : dep_orphs (mi_deps iface)
    
    2126 2128
     
    
    2127 2129
            ; !orphs <- fmap (force . concat) . forM (ic_imports icxt) $ \i ->
    
    2128 2130
                 case i of                   -- force above: see #15111
    
    2129
    -                IIModule n -> getOrphans n NoPkgQual
    
    2130
    -                IIDecl i   -> getOrphans (unLoc (ideclName i))
    
    2131
    +                IIModule n -> getOrphansForModule n
    
    2132
    +                IIDecl i   -> getOrphansForModuleName (unLoc (ideclName i))
    
    2131 2133
                                              (renameRawPkgQual (hsc_unit_env hsc_env) (unLoc $ ideclName i) (ideclPkgQual i))
    
    2132 2134
     
    
    2133 2135
     
    

  • compiler/GHC/Types/Name/Ppr.hs
    ... ... @@ -13,6 +13,7 @@ import GHC.Data.FastString
    13 13
     
    
    14 14
     import GHC.Unit
    
    15 15
     import GHC.Unit.Env
    
    16
    +import qualified GHC.Unit.Home.Graph as HUG
    
    16 17
     
    
    17 18
     import GHC.Types.Name
    
    18 19
     import GHC.Types.Name.Reader
    
    ... ... @@ -72,12 +73,11 @@ mkNamePprCtx :: Outputable info => PromotionTickContext -> UnitEnv -> GlobalRdrE
    72 73
     mkNamePprCtx ptc unit_env env
    
    73 74
      = QueryQualify
    
    74 75
           (mkQualName env)
    
    75
    -      (mkQualModule unit_state home_unit)
    
    76
    +      (mkQualModule unit_state unit_env)
    
    76 77
           (mkQualPackage unit_state)
    
    77 78
           (mkPromTick ptc env)
    
    78 79
       where
    
    79 80
       unit_state = ue_homeUnitState unit_env
    
    80
    -  home_unit  = ue_homeUnit unit_env
    
    81 81
     
    
    82 82
     mkQualName :: Outputable info => GlobalRdrEnvX info -> QueryQualifyName
    
    83 83
     mkQualName env = qual_name where
    
    ... ... @@ -215,10 +215,12 @@ Side note (int-index):
    215 215
     -- | Creates a function for formatting modules based on two heuristics:
    
    216 216
     -- (1) if the module is the current module, don't qualify, and (2) if there
    
    217 217
     -- is only one exposed package which exports this module, don't qualify.
    
    218
    -mkQualModule :: UnitState -> Maybe HomeUnit -> QueryQualifyModule
    
    219
    -mkQualModule unit_state mhome_unit mod
    
    220
    -     | Just home_unit <- mhome_unit
    
    221
    -     , isHomeModule home_unit mod = False
    
    218
    +mkQualModule :: UnitState -> UnitEnv -> QueryQualifyModule
    
    219
    +mkQualModule unit_state unitEnv mod
    
    220
    +       -- Check whether the unit of the module is in the HomeUnitGraph.
    
    221
    +       -- If it is, then we consider this 'mod' to be "local" and don't
    
    222
    +       -- want to qualify it.
    
    223
    +     | HUG.memberHugUnit (moduleUnit mod) (ue_home_unit_graph unitEnv) = False
    
    222 224
     
    
    223 225
          | [(_, pkgconfig)] <- lookup,
    
    224 226
            mkUnit pkgconfig == moduleUnit mod
    

  • compiler/GHC/Unit/Env.hs
    ... ... @@ -241,7 +241,7 @@ isUnitEnvInstalledModule ue m = maybe False (`isHomeInstalledModule` m) hu
    241 241
     -- -------------------------------------------------------
    
    242 242
     
    
    243 243
     ue_findHomeUnitEnv :: HasDebugCallStack => UnitId -> UnitEnv -> HomeUnitEnv
    
    244
    -ue_findHomeUnitEnv uid e = case HUG.lookupHugUnit uid (ue_home_unit_graph e) of
    
    244
    +ue_findHomeUnitEnv uid e = case HUG.lookupHugUnitId uid (ue_home_unit_graph e) of
    
    245 245
       Nothing -> pprPanic "Unit unknown to the internal unit environment"
    
    246 246
                   $  text "unit (" <> ppr uid <> text ")"
    
    247 247
                   $$ ppr (HUG.allUnits (ue_home_unit_graph e))
    
    ... ... @@ -311,7 +311,7 @@ ue_unitHomeUnit uid = expectJust . ue_unitHomeUnit_maybe uid
    311 311
     
    
    312 312
     ue_unitHomeUnit_maybe :: UnitId -> UnitEnv -> Maybe HomeUnit
    
    313 313
     ue_unitHomeUnit_maybe uid ue_env =
    
    314
    -  HUG.homeUnitEnv_home_unit =<< HUG.lookupHugUnit uid (ue_home_unit_graph ue_env)
    
    314
    +  HUG.homeUnitEnv_home_unit =<< HUG.lookupHugUnitId uid (ue_home_unit_graph ue_env)
    
    315 315
     
    
    316 316
     -- -------------------------------------------------------
    
    317 317
     -- Query and modify the currently active unit
    
    ... ... @@ -319,7 +319,7 @@ ue_unitHomeUnit_maybe uid ue_env =
    319 319
     
    
    320 320
     ue_currentHomeUnitEnv :: HasDebugCallStack => UnitEnv -> HomeUnitEnv
    
    321 321
     ue_currentHomeUnitEnv e =
    
    322
    -  case HUG.lookupHugUnit (ue_currentUnit e) (ue_home_unit_graph e) of
    
    322
    +  case HUG.lookupHugUnitId (ue_currentUnit e) (ue_home_unit_graph e) of
    
    323 323
         Just unitEnv -> unitEnv
    
    324 324
         Nothing -> pprPanic "packageNotFound" $
    
    325 325
           (ppr $ ue_currentUnit e) $$ ppr (HUG.allUnits (ue_home_unit_graph e))
    
    ... ... @@ -389,7 +389,7 @@ ue_transitiveHomeDeps uid e =
    389 389
     -- FIXME: Shouldn't this be a proper assertion only used in debug mode?
    
    390 390
     assertUnitEnvInvariant :: HasDebugCallStack => UnitEnv -> UnitEnv
    
    391 391
     assertUnitEnvInvariant u =
    
    392
    -  case HUG.lookupHugUnit (ue_current_unit u) (ue_home_unit_graph u) of
    
    392
    +  case HUG.lookupHugUnitId (ue_current_unit u) (ue_home_unit_graph u) of
    
    393 393
         Just _ -> u
    
    394 394
         Nothing ->
    
    395 395
           pprPanic "invariant" (ppr (ue_current_unit u) $$ ppr (HUG.allUnits (ue_home_unit_graph u)))
    

  • compiler/GHC/Unit/Home/Graph.hs
    ... ... @@ -34,7 +34,10 @@ module GHC.Unit.Home.Graph
    34 34
       , lookupHug
    
    35 35
       , lookupHugByModule
    
    36 36
       , lookupHugUnit
    
    37
    -
    
    37
    +  , lookupHugUnitId
    
    38
    +  , lookupAllHug
    
    39
    +  , memberHugUnit
    
    40
    +  , memberHugUnitId
    
    38 41
       -- ** Reachability
    
    39 42
       , transitiveHomeDeps
    
    40 43
     
    
    ... ... @@ -62,6 +65,8 @@ module GHC.Unit.Home.Graph
    62 65
       , unitEnv_insert
    
    63 66
       , unitEnv_new
    
    64 67
       , unitEnv_lookup
    
    68
    +  , unitEnv_traverseWithKey
    
    69
    +  , unitEnv_assocs
    
    65 70
       ) where
    
    66 71
     
    
    67 72
     import GHC.Prelude
    
    ... ... @@ -73,6 +78,7 @@ import GHC.Unit.Home.PackageTable
    73 78
     import GHC.Unit.Module
    
    74 79
     import GHC.Unit.Module.ModIface
    
    75 80
     import GHC.Unit.State
    
    81
    +import GHC.Utils.Monad (mapMaybeM)
    
    76 82
     import GHC.Utils.Outputable
    
    77 83
     import GHC.Utils.Panic
    
    78 84
     
    
    ... ... @@ -222,7 +228,7 @@ updateUnitFlags uid f = unitEnv_adjust update uid
    222 228
     -- | Compute the transitive closure of a unit in the 'HomeUnitGraph'.
    
    223 229
     -- If the argument unit is not present in the graph returns Nothing.
    
    224 230
     transitiveHomeDeps :: UnitId -> HomeUnitGraph -> Maybe [UnitId]
    
    225
    -transitiveHomeDeps uid hug = case lookupHugUnit uid hug of
    
    231
    +transitiveHomeDeps uid hug = case lookupHugUnitId uid hug of
    
    226 232
       Nothing -> Nothing
    
    227 233
       Just hue -> Just $
    
    228 234
         Set.toList (loop (Set.singleton uid) (homeUnitDepends (homeUnitEnv_units hue)))
    
    ... ... @@ -234,7 +240,7 @@ transitiveHomeDeps uid hug = case lookupHugUnit uid hug of
    234 240
               let hue = homeUnitDepends
    
    235 241
                         . homeUnitEnv_units
    
    236 242
                         . expectJust
    
    237
    -                    $ lookupHugUnit uid hug
    
    243
    +                    $ lookupHugUnitId uid hug
    
    238 244
               in loop (Set.insert uid acc) (hue ++ uids)
    
    239 245
     
    
    240 246
     --------------------------------------------------------------------------------
    
    ... ... @@ -246,21 +252,47 @@ transitiveHomeDeps uid hug = case lookupHugUnit uid hug of
    246 252
     lookupHug :: HomeUnitGraph -> UnitId -> ModuleName -> IO (Maybe HomeModInfo)
    
    247 253
     lookupHug hug uid mod = do
    
    248 254
       case unitEnv_lookup_maybe uid hug of
    
    249
    -    -- Really, here we want "lookup HPT" rather than unitEnvLookup
    
    250 255
         Nothing -> pure Nothing
    
    251 256
         Just hue -> lookupHpt (homeUnitEnv_hpt hue) mod
    
    252 257
     
    
    253 258
     -- | Lookup the 'HomeModInfo' of a 'Module' in the 'HomeUnitGraph' (via the 'HomePackageTable' of the corresponding unit)
    
    254 259
     lookupHugByModule :: Module -> HomeUnitGraph -> IO (Maybe HomeModInfo)
    
    255
    -lookupHugByModule mod hug
    
    256
    -  | otherwise = do
    
    257
    -      case unitEnv_lookup_maybe (toUnitId $ moduleUnit mod) hug of
    
    258
    -        Nothing -> pure Nothing
    
    259
    -        Just env -> lookupHptByModule (homeUnitEnv_hpt env) mod
    
    260
    +lookupHugByModule mod hug =
    
    261
    +  case lookupHugUnit (moduleUnit mod) hug of
    
    262
    +    Nothing -> pure Nothing
    
    263
    +    Just env -> lookupHptByModule (homeUnitEnv_hpt env) mod
    
    264
    +
    
    265
    +-- | Lookup all 'HomeModInfo' that have the same 'ModuleName' as the given 'ModuleName'.
    
    266
    +-- 'ModuleName's are not unique in the case of multiple home units, so there can be
    
    267
    +-- more than one possible 'HomeModInfo'.
    
    268
    +--
    
    269
    +-- You should always prefer 'lookupHug' and 'lookupHugByModule' when possible.
    
    270
    +lookupAllHug :: HomeUnitGraph -> ModuleName -> IO [HomeModInfo]
    
    271
    +lookupAllHug hug mod = mapMaybeM (\uid -> lookupHug hug uid mod) (Set.toList $ unitEnv_keys hug)
    
    260 272
     
    
    261 273
     -- | Lookup a 'HomeUnitEnv' by 'UnitId' in a 'HomeUnitGraph'
    
    262
    -lookupHugUnit :: UnitId -> HomeUnitGraph -> Maybe HomeUnitEnv
    
    263
    -lookupHugUnit = unitEnv_lookup_maybe
    
    274
    +lookupHugUnitId :: UnitId -> HomeUnitGraph -> Maybe HomeUnitEnv
    
    275
    +lookupHugUnitId = unitEnv_lookup_maybe
    
    276
    +
    
    277
    +-- | Check whether the 'UnitId' is present in the 'HomeUnitGraph'
    
    278
    +memberHugUnitId :: UnitId -> HomeUnitGraph -> Bool
    
    279
    +memberHugUnitId u = isJust . lookupHugUnitId u
    
    280
    +
    
    281
    +-- | Lookup up the 'HomeUnitEnv' by the 'Unit' in the 'HomeUnitGraph'.
    
    282
    +-- If the 'Unit' can be turned into a 'UnitId', we behave identical to 'lookupHugUnitId'.
    
    283
    +--
    
    284
    +-- A 'HoleUnit' is never part of the 'HomeUnitGraph', only instantiated 'Unit's
    
    285
    +lookupHugUnit :: Unit -> HomeUnitGraph -> Maybe HomeUnitEnv
    
    286
    +lookupHugUnit unit hug =
    
    287
    +  if isHoleUnit unit
    
    288
    +    then Nothing
    
    289
    +    else lookupHugUnitId (toUnitId unit) hug
    
    290
    +
    
    291
    +-- | Check whether the 'Unit' is present in the 'HomeUnitGraph'
    
    292
    +--
    
    293
    +-- A 'HoleUnit' is never part of the 'HomeUnitGraph', only instantiated 'Unit's
    
    294
    +memberHugUnit :: Unit -> HomeUnitGraph -> Bool
    
    295
    +memberHugUnit u = isJust . lookupHugUnit u
    
    264 296
     
    
    265 297
     --------------------------------------------------------------------------------
    
    266 298
     -- * Internal representation map
    
    ... ... @@ -313,6 +345,13 @@ unitEnv_foldWithKey f z (UnitEnvGraph g)= Map.foldlWithKey' f z g
    313 345
     unitEnv_lookup :: UnitEnvGraphKey -> UnitEnvGraph v -> v
    
    314 346
     unitEnv_lookup u env = expectJust $ unitEnv_lookup_maybe u env
    
    315 347
     
    
    348
    +unitEnv_traverseWithKey :: Applicative f => (UnitEnvGraphKey -> a -> f b) -> UnitEnvGraph a -> f (UnitEnvGraph b)
    
    349
    +unitEnv_traverseWithKey f unitEnv =
    
    350
    +  UnitEnvGraph <$> Map.traverseWithKey f (unitEnv_graph unitEnv)
    
    351
    +
    
    352
    +unitEnv_assocs :: UnitEnvGraph a -> [(UnitEnvGraphKey, a)]
    
    353
    +unitEnv_assocs (UnitEnvGraph x) = Map.assocs x
    
    354
    +
    
    316 355
     --------------------------------------------------------------------------------
    
    317 356
     -- * Utilities
    
    318 357
     --------------------------------------------------------------------------------
    

  • compiler/GHC/Unit/Types.hs
    ... ... @@ -63,12 +63,16 @@ module GHC.Unit.Types
    63 63
        , mainUnitId
    
    64 64
        , thisGhcUnitId
    
    65 65
        , interactiveUnitId
    
    66
    +   , interactiveGhciUnitId
    
    67
    +   , interactiveSessionUnitId
    
    66 68
     
    
    67 69
        , ghcInternalUnit
    
    68 70
        , rtsUnit
    
    69 71
        , mainUnit
    
    70 72
        , thisGhcUnit
    
    71 73
        , interactiveUnit
    
    74
    +   , interactiveGhciUnit
    
    75
    +   , interactiveSessionUnit
    
    72 76
     
    
    73 77
        , isInteractiveModule
    
    74 78
        , wiredInUnitIds
    
    ... ... @@ -588,20 +592,24 @@ Make sure you change 'GHC.Unit.State.findWiredInUnits' if you add an entry here.
    588 592
     -}
    
    589 593
     
    
    590 594
     ghcInternalUnitId, rtsUnitId,
    
    591
    -  mainUnitId, thisGhcUnitId, interactiveUnitId :: UnitId
    
    595
    +  mainUnitId, thisGhcUnitId, interactiveUnitId, interactiveGhciUnitId, interactiveSessionUnitId :: UnitId
    
    592 596
     
    
    593 597
     ghcInternalUnit, rtsUnit,
    
    594
    -  mainUnit, thisGhcUnit, interactiveUnit :: Unit
    
    598
    +  mainUnit, thisGhcUnit, interactiveUnit, interactiveGhciUnit, interactiveSessionUnit :: Unit
    
    595 599
     
    
    596 600
     ghcInternalUnitId = UnitId (fsLit "ghc-internal")
    
    597 601
     rtsUnitId         = UnitId (fsLit "rts")
    
    598 602
     thisGhcUnitId     = UnitId (fsLit cProjectUnitId) -- See Note [GHC's Unit Id]
    
    599 603
     interactiveUnitId = UnitId (fsLit "interactive")
    
    604
    +interactiveGhciUnitId = UnitId (fsLit "interactive-ghci")
    
    605
    +interactiveSessionUnitId = UnitId (fsLit "interactive-session")
    
    600 606
     
    
    601 607
     ghcInternalUnit   = RealUnit (Definite ghcInternalUnitId)
    
    602 608
     rtsUnit           = RealUnit (Definite rtsUnitId)
    
    603 609
     thisGhcUnit       = RealUnit (Definite thisGhcUnitId)
    
    604 610
     interactiveUnit   = RealUnit (Definite interactiveUnitId)
    
    611
    +interactiveGhciUnit = RealUnit (Definite interactiveGhciUnitId)
    
    612
    +interactiveSessionUnit = RealUnit (Definite interactiveSessionUnitId)
    
    605 613
     
    
    606 614
     -- | This is the package Id for the current program.  It is the default
    
    607 615
     -- package Id if you don't specify a package name.  We don't add this prefix
    

  • docs/users_guide/ghci.rst
    ... ... @@ -251,8 +251,8 @@ We can compile ``D``, then load the whole program, like this:
    251 251
     
    
    252 252
     .. code-block:: none
    
    253 253
     
    
    254
    -    ghci> :! ghc -c -dynamic D.hs
    
    255
    -    ghci> :load A
    
    254
    +    ghci> :! ghc -c -this-unit-id interactive-session -dynamic D.hs
    
    255
    +    ghci> :load A B C D
    
    256 256
         Compiling B                ( B.hs, interpreted )
    
    257 257
         Compiling C                ( C.hs, interpreted )
    
    258 258
         Compiling A                ( A.hs, interpreted )
    
    ... ... @@ -268,6 +268,10 @@ Note the :ghc-flag:`-dynamic` flag to GHC: GHCi uses dynamically-linked object
    268 268
     code (if you are on a platform that supports it), and so in order to use
    
    269 269
     compiled code with GHCi it must be compiled for dynamic linking.
    
    270 270
     
    
    271
    +Also, note the :ghc-flag:`-this-unit-id` `interactive-session` to GHC: GHCi
    
    272
    +can only use the object code of a module loaded via :ghci-cmd:`:load`,
    
    273
    +if the object code has been compiled for the `interactive-session`.
    
    274
    +
    
    271 275
     At any time you can use the command :ghci-cmd:`:show modules` to get a list of
    
    272 276
     the modules currently loaded into GHCi:
    
    273 277
     
    
    ... ... @@ -301,8 +305,8 @@ So let's try compiling one of the other modules:
    301 305
     
    
    302 306
     .. code-block:: none
    
    303 307
     
    
    304
    -    *ghci> :! ghc -c C.hs
    
    305
    -    *ghci> :load A
    
    308
    +    *ghci> :! ghc -c -this-unit-id interactive-session -dynamic C.hs
    
    309
    +    *ghci> :load A B C D
    
    306 310
         Compiling D                ( D.hs, interpreted )
    
    307 311
         Compiling B                ( B.hs, interpreted )
    
    308 312
         Compiling C                ( C.hs, interpreted )
    
    ... ... @@ -316,7 +320,7 @@ rejected ``C``\'s object file. Ok, so let's also compile ``D``:
    316 320
     
    
    317 321
     .. code-block:: none
    
    318 322
     
    
    319
    -    *ghci> :! ghc -c D.hs
    
    323
    +    *ghci> :! ghc -c -this-unit-id interactive-session -dynamic D.hs
    
    320 324
         *ghci> :reload
    
    321 325
         Ok, modules loaded: A, B, C, D.
    
    322 326
     
    
    ... ... @@ -325,7 +329,7 @@ picked up by :ghci-cmd:`:reload`, only :ghci-cmd:`:load`:
    325 329
     
    
    326 330
     .. code-block:: none
    
    327 331
     
    
    328
    -    *ghci> :load A
    
    332
    +    *ghci> :load A B C D
    
    329 333
         Compiling B                ( B.hs, interpreted )
    
    330 334
         Compiling A                ( A.hs, interpreted )
    
    331 335
         Ok, modules loaded: A, B, C (C.o), D (D.o).
    

  • ghc/GHCi/UI.hs
    ... ... @@ -113,6 +113,7 @@ import GHC.Utils.Misc
    113 113
     import qualified GHC.LanguageExtensions as LangExt
    
    114 114
     import qualified GHC.Data.Strict as Strict
    
    115 115
     import GHC.Types.Error
    
    116
    +import qualified GHC.Unit.Home.Graph as HUG
    
    116 117
     
    
    117 118
     -- Haskell Libraries
    
    118 119
     import System.Console.Haskeline as Haskeline
    
    ... ... @@ -129,6 +130,7 @@ import Data.Array
    129 130
     import qualified Data.ByteString.Char8 as BS
    
    130 131
     import Data.Char
    
    131 132
     import Data.Function
    
    133
    +import qualified Data.Foldable as Foldable
    
    132 134
     import Data.IORef ( IORef, modifyIORef, newIORef, readIORef, writeIORef )
    
    133 135
     import Data.List ( find, intercalate, intersperse,
    
    134 136
                        isPrefixOf, isSuffixOf, nub, partition, sort, sortBy, (\\) )
    
    ... ... @@ -204,31 +206,31 @@ ghciCommands = map mkCmd [
    204 206
       -- Hugs users are accustomed to :e, so make sure it doesn't overlap
    
    205 207
       ("?",         keepGoing help,                 noCompletion),
    
    206 208
       ("add",       keepGoingPaths addModule,       completeFilename),
    
    207
    -  ("abandon",   keepGoing abandonCmd,           noCompletion),
    
    208
    -  ("break",     keepGoing breakCmd,             completeBreakpoint),
    
    209
    -  ("back",      keepGoing backCmd,              noCompletion),
    
    209
    +  ("abandon",   keepGoing  abandonCmd,          noCompletion),
    
    210
    +  ("break",     keepGoing  breakCmd,            completeBreakpoint),
    
    211
    +  ("back",      keepGoing  backCmd,             noCompletion),
    
    210 212
       ("browse",    keepGoing' (browseCmd False),   completeModule),
    
    211 213
       ("browse!",   keepGoing' (browseCmd True),    completeModule),
    
    212
    -  ("cd",        keepGoingMulti' changeDirectory,     completeFilename),
    
    213
    -  ("continue",  keepGoing continueCmd,          noCompletion),
    
    214
    +  ("cd",        keepGoing' changeDirectory,     completeFilename),
    
    215
    +  ("continue",  keepGoing' continueCmd,         noCompletion),
    
    214 216
       ("cmd",       keepGoing cmdCmd,               completeExpression),
    
    215 217
       ("def",       keepGoing (defineMacro False),  completeExpression),
    
    216 218
       ("def!",      keepGoing (defineMacro True),   completeExpression),
    
    217 219
       ("delete",    keepGoing deleteCmd,            noCompletion),
    
    218 220
       ("disable",   keepGoing disableCmd,           noCompletion),
    
    219 221
       ("doc",       keepGoing' docCmd,              completeIdentifier),
    
    220
    -  ("edit",      keepGoingMulti' editFile,            completeFilename),
    
    222
    +  ("edit",      keepGoing' editFile,            completeFilename),
    
    221 223
       ("enable",    keepGoing enableCmd,            noCompletion),
    
    222 224
       ("force",     keepGoing forceCmd,             completeExpression),
    
    223 225
       ("forward",   keepGoing forwardCmd,           noCompletion),
    
    224
    -  ("help",      keepGoingMulti help,                 noCompletion),
    
    225
    -  ("history",   keepGoingMulti historyCmd,           noCompletion),
    
    226
    -  ("info",      keepGoingMulti' (info False),        completeIdentifier),
    
    227
    -  ("info!",     keepGoingMulti' (info True),         completeIdentifier),
    
    226
    +  ("help",      keepGoing help,                 noCompletion),
    
    227
    +  ("history",   keepGoing historyCmd,           noCompletion),
    
    228
    +  ("info",      keepGoing' (info False),        completeIdentifier),
    
    229
    +  ("info!",     keepGoing' (info True),         completeIdentifier),
    
    228 230
       ("issafe",    keepGoing' isSafeCmd,           completeModule),
    
    229 231
       ("ignore",    keepGoing ignoreCmd,            noCompletion),
    
    230
    -  ("kind",      keepGoingMulti' (kindOfType False),  completeIdentifier),
    
    231
    -  ("kind!",     keepGoingMulti' (kindOfType True),   completeIdentifier),
    
    232
    +  ("kind",      keepGoing' (kindOfType False),  completeIdentifier),
    
    233
    +  ("kind!",     keepGoing' (kindOfType True),   completeIdentifier),
    
    232 234
       ("load",      keepGoingPaths loadModule_,     completeHomeModuleOrFile),
    
    233 235
       ("load!",     keepGoingPaths loadModuleDefer, completeHomeModuleOrFile),
    
    234 236
       ("list",      keepGoing' listCmd,             noCompletion),
    
    ... ... @@ -236,19 +238,19 @@ ghciCommands = map mkCmd [
    236 238
       ("main",      keepGoing runMain,              completeFilename),
    
    237 239
       ("print",     keepGoing printCmd,             completeExpression),
    
    238 240
       ("quit",      quit,                           noCompletion),
    
    239
    -  ("reload",    keepGoingMulti' reloadModule,   noCompletion),
    
    240
    -  ("reload!",   keepGoingMulti' reloadModuleDefer,   noCompletion),
    
    241
    -  ("run",       keepGoing runRun,               completeFilename),
    
    241
    +  ("reload",    keepGoing' reloadModule,        noCompletion),
    
    242
    +  ("reload!",   keepGoing' reloadModuleDefer,   noCompletion),
    
    243
    +  ("run",       keepGoing' runRun,              completeFilename),
    
    242 244
       ("script",    keepGoing' scriptCmd,           completeFilename),
    
    243
    -  ("set",       keepGoingMulti setCmd,          completeSetOptions),
    
    244
    -  ("seti",      keepGoingMulti setiCmd,         completeSeti),
    
    245
    -  ("show",      keepGoingMulti' showCmd,        completeShowOptions),
    
    246
    -  ("showi",     keepGoing showiCmd,             completeShowiOptions),
    
    245
    +  ("set",       keepGoing setCmd,               completeSetOptions),
    
    246
    +  ("seti",      keepGoing setiCmd,              completeSeti),
    
    247
    +  ("show",      keepGoing' showCmd,             completeShowOptions),
    
    248
    +  ("showi",     keepGoing  showiCmd,            completeShowiOptions),
    
    247 249
       ("sprint",    keepGoing sprintCmd,            completeExpression),
    
    248 250
       ("step",      keepGoing stepCmd,              completeIdentifier),
    
    249 251
       ("steplocal", keepGoing stepLocalCmd,         completeIdentifier),
    
    250 252
       ("stepmodule",keepGoing stepModuleCmd,        completeIdentifier),
    
    251
    -  ("type",      keepGoingMulti' typeOfExpr,          completeExpression),
    
    253
    +  ("type",      keepGoing' typeOfExpr,          completeExpression),
    
    252 254
       ("trace",     keepGoing traceCmd,             completeExpression),
    
    253 255
       ("unadd",     keepGoingPaths unAddModule,     completeFilename),
    
    254 256
       ("undef",     keepGoing undefineMacro,        completeMacro),
    
    ... ... @@ -316,24 +318,11 @@ showSDocForUserQualify doc = do
    316 318
     keepGoing :: (String -> GHCi ()) -> (String -> InputT GHCi CmdExecOutcome)
    
    317 319
     keepGoing a str = keepGoing' (lift . a) str
    
    318 320
     
    
    319
    -keepGoingMulti :: (String -> GHCi ()) -> (String -> InputT GHCi CmdExecOutcome)
    
    320
    -keepGoingMulti a str = keepGoingMulti' (lift . a) str
    
    321
    -
    
    322 321
     keepGoing' :: GhciMonad m => (a -> m ()) -> a -> m CmdExecOutcome
    
    323 322
     keepGoing' a str = do
    
    324
    -  in_multi <- inMultiMode
    
    325
    -  if in_multi
    
    326
    -    then reportError GhciCommandNotSupportedInMultiMode
    
    327
    -    else a str
    
    323
    +  a str
    
    328 324
       return CmdSuccess
    
    329 325
     
    
    330
    --- For commands which are actually support in multi-mode, initially just :reload
    
    331
    -keepGoingMulti' :: GhciMonad m => (String -> m ()) -> String -> m CmdExecOutcome
    
    332
    -keepGoingMulti' a str = a str >> return CmdSuccess
    
    333
    -
    
    334
    -inMultiMode :: GhciMonad m => m Bool
    
    335
    -inMultiMode = multiMode <$> getGHCiState
    
    336
    -
    
    337 326
     keepGoingPaths :: ([FilePath] -> InputT GHCi ()) -> (String -> InputT GHCi CmdExecOutcome)
    
    338 327
     keepGoingPaths a str
    
    339 328
      = do case toArgsNoLoc str of
    
    ... ... @@ -489,9 +478,6 @@ default_args = []
    489 478
     interactiveUI :: GhciSettings -> [(FilePath, Maybe UnitId, Maybe Phase)] -> Maybe [String]
    
    490 479
                   -> Ghc ()
    
    491 480
     interactiveUI config srcs maybe_exprs = do
    
    492
    -   -- This is a HACK to make sure dynflags are not overwritten when setting
    
    493
    -   -- options. When GHCi is made properly multi component it should be removed.
    
    494
    -   modifySession (\env -> hscSetActiveUnitId (hscActiveUnitId env) env)
    
    495 481
        -- HACK! If we happen to get into an infinite loop (eg the user
    
    496 482
        -- types 'let x=x in x' at the prompt), then the thread will block
    
    497 483
        -- on a blackhole, and become unreachable during GC.  The GC will
    
    ... ... @@ -507,21 +493,7 @@ interactiveUI config srcs maybe_exprs = do
    507 493
         -- Initialise buffering for the *interpreted* I/O system
    
    508 494
        (nobuffering, flush) <- runInternal initInterpBuffering
    
    509 495
     
    
    510
    -   -- The initial set of DynFlags used for interactive evaluation is the same
    
    511
    -   -- as the global DynFlags, plus -XExtendedDefaultRules and
    
    512
    -   -- -XNoMonomorphismRestriction.
    
    513
    -   -- See Note [Changing language extensions for interactive evaluation] #10857
    
    514
    -   dflags <- getDynFlags
    
    515
    -   let dflags' = (xopt_set_unlessExplSpec
    
    516
    -                      LangExt.ExtendedDefaultRules xopt_set)
    
    517
    -               . (xopt_set_unlessExplSpec
    
    518
    -                      LangExt.MonomorphismRestriction xopt_unset)
    
    519
    -               $ dflags
    
    520
    -   GHC.setInteractiveDynFlags dflags'
    
    521
    -   _ <- GHC.setProgramDynFlags
    
    522
    -               -- Set Opt_KeepGoing so that :reload loads as much as
    
    523
    -               -- possible
    
    524
    -               (gopt_set dflags Opt_KeepGoing)
    
    496
    +   installInteractiveHomeUnits
    
    525 497
     
    
    526 498
        -- Update the LogAction. Ensure we don't override the user's log action lest
    
    527 499
        -- we break -ddump-json (#14078)
    
    ... ... @@ -553,9 +525,6 @@ interactiveUI config srcs maybe_exprs = do
    553 525
              case simpleImportDecl preludeModuleName of
    
    554 526
                -- Set to True because Prelude is implicitly imported.
    
    555 527
                impDecl@ImportDecl{ideclExt=ext} -> impDecl{ideclExt = ext{ideclImplicit=True}}
    
    556
    -   hsc_env <- GHC.getSession
    
    557
    -   let !in_multi = length (hsc_all_home_unit_ids hsc_env) > 1
    
    558
    -        -- We force this to make sure we don't retain the hsc_env when reloading
    
    559 528
        empty_cache <- liftIO newIfaceCache
    
    560 529
        startGHCi (runGHCi srcs maybe_exprs)
    
    561 530
             GHCiState{ progname           = default_progname,
    
    ... ... @@ -566,7 +535,6 @@ interactiveUI config srcs maybe_exprs = do
    566 535
                        stop               = default_stop,
    
    567 536
                        editor             = default_editor,
    
    568 537
                        options            = [],
    
    569
    -                   multiMode          = in_multi,
    
    570 538
                        localConfig        = SourceLocalConfig,
    
    571 539
                        -- We initialize line number as 0, not 1, because we use
    
    572 540
                        -- current line number while reporting errors which is
    
    ... ... @@ -595,6 +563,236 @@ interactiveUI config srcs maybe_exprs = do
    595 563
     
    
    596 564
        return ()
    
    597 565
     
    
    566
    +{-
    
    567
    +Note [Multiple Home Units aware GHCi]
    
    568
    +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    
    569
    +GHCi supports multiple home units natively and as a first class citizen.
    
    570
    +All GHCi sessions use a multiple home unit session and have at least three
    
    571
    +home units:
    
    572
    +
    
    573
    +1. A home unit for the ghci session prompt
    
    574
    +2. A home unit for scripts (i.e., modules that are ':load'ed or ':add'ed.)
    
    575
    +3. The home unit specified by the user.
    
    576
    +3+. If the users themselves provides more than one home unit.
    
    577
    +
    
    578
    +The first home unit is the "interactive-ghci" unit, called the 'interactiveGhciUnit'.
    
    579
    +It contains the same 'DynFlags' that are used by the 'InteractiveContext' for
    
    580
    +interactive evaluation of expressions.
    
    581
    +This 'HomeUnitEnv' is only used on the prompt of GHCi, so we may refer to it as
    
    582
    +"interactive-prompt" unit.
    
    583
    +See Note [Relation between the 'InteractiveContext' and 'interactiveGhciUnitId']
    
    584
    +for discussing its role.
    
    585
    +
    
    586
    +The second home unit is the "interactive-session", called 'interactiveSessionUnit'
    
    587
    +which is used for loading Scripts into GHCi that are not 'Target's of any home unit,
    
    588
    +via `:load` or `:add`.
    
    589
    +This home unit is necessary, as we can't guess to which home unit the 'Target' should
    
    590
    +be added.
    
    591
    +
    
    592
    +Both of these "interactive" home units depend on all other 'HomeUnitEnv's that
    
    593
    +are passed as arguments on the cli.
    
    594
    +Additionally, the "interactive-ghci" unit depends on "interactive-session".
    
    595
    +
    
    596
    +We always evaluate expressions in the context of the
    
    597
    +"interactive-ghci" session.
    
    598
    +Since "interactive-ghci" depends on all home units, we can import any 'Module'
    
    599
    +from the other home units with ease.
    
    600
    +
    
    601
    +As we have a clear 'HomeUnitGraph' hierarchy, we can set 'interactiveGhciUnitId'
    
    602
    +as the active home unit for the full duration of the GHCi session.
    
    603
    +In GHCi, we always set 'interactiveGhciUnitId' to be the currently active home unit.
    
    604
    +
    
    605
    +=== Single Home Unit Case Diagram
    
    606
    +
    
    607
    + Example:       ghci -this-unit-id main ...
    
    608
    + Equivalent to: ghci -unit @unitA
    
    609
    +
    
    610
    + ┌───────────────────┐        ┌─────────────────────┐
    
    611
    + │ Interactive Prompt│        │ Interactive Session │
    
    612
    + │                   │───────►│                     │
    
    613
    + │  interactive-ghci │        │ interactive-session │
    
    614
    + └────────┬──────────┘        └──────────┬──────────┘
    
    615
    +          │                              │
    
    616
    +          └───────────────┬──────────────┘
    
    617
    +
    
    618
    +
    
    619
    +                     ┌────▼───┐
    
    620
    +                     │ Unit A │
    
    621
    +                     │ main   │
    
    622
    +                     └────────┘
    
    623
    +
    
    624
    +
    
    625
    +=== Multi Home Unit Case Diagram
    
    626
    +
    
    627
    + Example:       ghci -unit @unitA -unit @unitB -unit @unitC
    
    628
    +
    
    629
    + ┌───────────────────┐        ┌─────────────────────┐
    
    630
    + │ Interactive Prompt│        │ Interactive Session │
    
    631
    + │                   │───────►│                     │
    
    632
    + │  interactive-ghci │        │ interactive-session │
    
    633
    + └────────┬──────────┘        └──────────┬──────────┘
    
    634
    +          │                              │
    
    635
    +          └───────────────┬──────────────┘
    
    636
    +
    
    637
    +            ┌─────────────┼─────────────┐
    
    638
    +       ┌────▼───┐    ┌────▼───┐    ┌────▼───┐
    
    639
    +       │ Unit A │    │ Unit B │    │ Unit C │
    
    640
    +       │ a-0.0  │    │ b-0.0  │    │ c-0.0  │
    
    641
    +       └────────┘    └────────┘    └────────┘
    
    642
    +
    
    643
    +As we can see, this design scales to an arbitrary number of Home Units.
    
    644
    +
    
    645
    +=== 'interactiveGhciUnit' Home Unit
    
    646
    +
    
    647
    +The 'interactiveGhciUnit' home unit is used for storing the 'DynFlags' of
    
    648
    +the interactive context.
    
    649
    +There is considerable overlap with the 'InteractiveContext,
    
    650
    +see Note [Relation between the 'InteractiveContext' and 'interactiveGhciUnitId']
    
    651
    +for details.
    
    652
    +
    
    653
    +The 'DynFlags' of the 'interactiveGhciUnit' can be modified by using `:seti`
    
    654
    +commands in the GHCi session.
    
    655
    +
    
    656
    +=== 'interactiveSessionUnit' Home Unit
    
    657
    +
    
    658
    +The 'interactiveSessionUnit' home unit is used as a kitchen sink for Modules that
    
    659
    +are not part of a home unit already.
    
    660
    +When the user types ":load", it is not trivial to figure to which home unit the module
    
    661
    +should be added to.
    
    662
    +Especially, when there is more than home unit. Thus, we always ":load"ed modules
    
    663
    +to this home unit.
    
    664
    +
    
    665
    +The 'DynFlags' of the 'interactiveSessionUnit' can be modified via the ':set'
    
    666
    +commands in the GHCi session.
    
    667
    +-}
    
    668
    +
    
    669
    +-- | Set up the multiple home unit session.
    
    670
    +-- Installs a 'HomeUnitEnv' for the ghci-prompt and one for the ghci-session in the
    
    671
    +-- current 'HscEnv'.
    
    672
    +--
    
    673
    +-- Installs the two home units 'interactiveGhciUnit' and 'interactiveSessionUnit', which
    
    674
    +-- both depend on any other 'HomeUnitEnv' that is already present in the current
    
    675
    +-- 'HomeUnitGraph'.
    
    676
    +--
    
    677
    +-- In other words, in each GHCi session, there are always at least three 'HomeUnitEnv's:
    
    678
    +--
    
    679
    +-- * 'interactiveGhciUnit'
    
    680
    +-- * 'interactiveSessionUnit'
    
    681
    +-- * 'mainUnit' (by default)
    
    682
    +--
    
    683
    +-- The 'interactiveGhciUnit' is the currently active unit, i.e. @hscActiveUnit hsc_env == 'interactiveGhciUnitId'@,
    
    684
    +-- and it stays as the active unit for the entire duration of GHCi.
    
    685
    +-- Within GHCi, you can rely on this property.
    
    686
    +--
    
    687
    +-- For motivation and design, see Note [Multiple Home Units aware GHCi]
    
    688
    +installInteractiveHomeUnits :: GHC.GhcMonad m => m ()
    
    689
    +installInteractiveHomeUnits = do
    
    690
    +  logger <- getLogger
    
    691
    +  hsc_env <- GHC.getSession
    
    692
    +  -- The initial set of DynFlags used for interactive evaluation is the same
    
    693
    +  -- as the global DynFlags, plus:
    
    694
    +  -- * -XExtendedDefaultRules and
    
    695
    +  -- * -XNoMonomorphismRestriction.
    
    696
    +  -- See Note [Changing language extensions for interactive evaluation] #10857
    
    697
    +  dflags <- getDynFlags
    
    698
    +  let
    
    699
    +    dflags0' =
    
    700
    +      (xopt_set_unlessExplSpec LangExt.ExtendedDefaultRules xopt_set) .
    
    701
    +      (xopt_set_unlessExplSpec LangExt.MonomorphismRestriction xopt_unset) $
    
    702
    +      dflags
    
    703
    +    -- Disable warnings about unused packages
    
    704
    +    -- It doesn't matter for the interactive session.
    
    705
    +    -- See Note [No unused package warnings for the interactive session]
    
    706
    +    dflags0 = wopt_unset dflags0' Opt_WarnUnusedPackages
    
    707
    +
    
    708
    +    -- Trivial '-package-id <uid>' flag
    
    709
    +    homeUnitPkgFlag uid =
    
    710
    +      ExposePackage
    
    711
    +        (unitIdString uid)
    
    712
    +        (UnitIdArg $ RealUnit (Definite uid))
    
    713
    +        (ModRenaming False [])
    
    714
    +
    
    715
    +    sessionUnitExposedFlag =
    
    716
    +      homeUnitPkgFlag interactiveSessionUnitId
    
    717
    +
    
    718
    +  -- Explicitly depends on all home units and 'sessionUnitExposedFlag'.
    
    719
    +  -- Normalise the 'dflagsPrompt', as they will be used for 'ic_dflags'
    
    720
    +  -- of the 'InteractiveContext'.
    
    721
    +  -- See Note [Relation between the 'InteractiveContext' and 'interactiveGhciUnitId']
    
    722
    +  -- Additionally, we remove all 'importPaths', to avoid accidentally adding
    
    723
    +  -- any 'Target's to this 'Unit'.
    
    724
    +  dflagsPrompt <- GHC.normaliseInteractiveDynFlags logger $
    
    725
    +    setHomeUnitId interactiveGhciUnitId $ dflags0
    
    726
    +      { packageFlags =
    
    727
    +        [ sessionUnitExposedFlag ] ++
    
    728
    +        [ homeUnitPkgFlag uid
    
    729
    +        | homeUnitEnv <- Foldable.toList $ hsc_HUG hsc_env
    
    730
    +        , Just homeUnit <- [homeUnitEnv_home_unit homeUnitEnv]
    
    731
    +        , let uid = homeUnitId homeUnit
    
    732
    +        ] ++
    
    733
    +        (packageFlags dflags0)
    
    734
    +      , importPaths = []
    
    735
    +      }
    
    736
    +
    
    737
    +  let
    
    738
    +    -- Explicitly depends on all current home units.
    
    739
    +    -- Additionally, we remove all 'importPaths', to avoid accidentally adding
    
    740
    +    -- any 'Target's to this 'Unit' that are not ':load'ed.
    
    741
    +    dflagsSession =
    
    742
    +      setHomeUnitId interactiveSessionUnitId $ dflags
    
    743
    +        { packageFlags =
    
    744
    +          [ homeUnitPkgFlag uid
    
    745
    +          | homeUnitEnv <- Foldable.toList $ hsc_HUG hsc_env
    
    746
    +          , Just homeUnit <- [homeUnitEnv_home_unit homeUnitEnv]
    
    747
    +          , let uid = homeUnitId homeUnit
    
    748
    +          ] ++
    
    749
    +          (packageFlags dflags)
    
    750
    +        , importPaths = []
    
    751
    +        }
    
    752
    +
    
    753
    +  let
    
    754
    +    cached_unit_dbs =
    
    755
    +        concat
    
    756
    +      . catMaybes
    
    757
    +      . fmap homeUnitEnv_unit_dbs
    
    758
    +      $ Foldable.toList
    
    759
    +      $ hsc_HUG hsc_env
    
    760
    +
    
    761
    +    all_unit_ids =
    
    762
    +      S.insert interactiveGhciUnitId $
    
    763
    +      S.insert interactiveSessionUnitId $
    
    764
    +      hsc_all_home_unit_ids hsc_env
    
    765
    +
    
    766
    +  ghciPromptUnit  <- setupHomeUnitFor logger dflagsPrompt  all_unit_ids cached_unit_dbs
    
    767
    +  ghciSessionUnit <- setupHomeUnitFor logger dflagsSession all_unit_ids cached_unit_dbs
    
    768
    +  let
    
    769
    +    -- Setup up the HUG, install the interactive home units
    
    770
    +    withInteractiveUnits =
    
    771
    +        HUG.unitEnv_insert interactiveGhciUnitId ghciPromptUnit
    
    772
    +        . HUG.unitEnv_insert interactiveSessionUnitId ghciSessionUnit
    
    773
    +
    
    774
    +  -- Finish up the setup, install the new HUG and make the 'interactiveGhciUnitId'
    
    775
    +  -- the active unit.
    
    776
    +  modifySessionM (\env -> do
    
    777
    +    -- Set the new HUG
    
    778
    +    let newEnv0 = hscUpdateHUG       withInteractiveUnits  env
    
    779
    +    -- Make sure the 'interactiveGhciUnitId' is active and 'hsc_dflags'
    
    780
    +    -- are populated correctly.
    
    781
    +    -- The 'interactiveGhciUnitId' will stay as the active unit within GHCi.
    
    782
    +    let newEnv1 = hscSetActiveUnitId interactiveGhciUnitId newEnv0
    
    783
    +    -- Use the 'DynFlags' of the 'interactiveGhciUnitId' for the 'InteractiveContext'.
    
    784
    +    GHC.initialiseInteractiveDynFlags dflagsPrompt newEnv1
    
    785
    +    )
    
    786
    +
    
    787
    +  pure ()
    
    788
    +  where
    
    789
    +    setupHomeUnitFor :: GHC.GhcMonad m => Logger -> DynFlags -> S.Set UnitId -> [UnitDatabase UnitId] -> m HomeUnitEnv
    
    790
    +    setupHomeUnitFor logger dflags all_home_units cached_unit_dbs = do
    
    791
    +      (dbs,unit_state,home_unit,_mconstants) <-
    
    792
    +        liftIO $ initUnits logger dflags (Just cached_unit_dbs) all_home_units
    
    793
    +      hpt <- liftIO emptyHomePackageTable
    
    794
    +      pure (HUG.mkHomeUnitEnv unit_state (Just dbs) dflags hpt (Just home_unit))
    
    795
    +
    
    598 796
     reportError :: GhciMonad m => GhciCommandMessage -> m ()
    
    599 797
     reportError err = do
    
    600 798
       printError err
    
    ... ... @@ -933,7 +1131,7 @@ getInfoForPrompt = do
    933 1131
                           | otherwise           = unLoc (ideclName d)
    
    934 1132
     
    
    935 1133
             modules_names =
    
    936
    -             ['*':(moduleNameString m) | IIModule m <- rev_imports] ++
    
    1134
    +             ['*':(moduleNameString (moduleName m)) | IIModule m <- rev_imports] ++
    
    937 1135
                  [moduleNameString (myIdeclName d) | IIDecl d <- rev_imports]
    
    938 1136
             line = 1 + line_number st
    
    939 1137
     
    
    ... ... @@ -1971,13 +2169,27 @@ wrapDeferTypeErrors :: GHC.GhcMonad m => m a -> m a
    1971 2169
     wrapDeferTypeErrors load =
    
    1972 2170
       MC.bracket
    
    1973 2171
         (do
    
    1974
    -      -- Force originalFlags to avoid leaking the associated HscEnv
    
    1975
    -      !originalFlags <- getDynFlags
    
    1976
    -      void $ GHC.setProgramDynFlags $
    
    1977
    -         setGeneralFlag' Opt_DeferTypeErrors originalFlags
    
    1978
    -      return originalFlags)
    
    1979
    -    (\originalFlags -> void $ GHC.setProgramDynFlags originalFlags)
    
    2172
    +      -- Force originalHUG to avoid leaking the associated HscEnv
    
    2173
    +      !originalHUG <- hsc_HUG <$> GHC.getSession
    
    2174
    +      _ <- GHC.setProgramHUG (fmap deferTypeErrors originalHUG)
    
    2175
    +      return originalHUG)
    
    2176
    +    (\originalHUG ->
    
    2177
    +      -- Restore the old 'DynFlags' for each home unit.
    
    2178
    +      -- This makes sure that '-fdefer-type-errors' is unset again, iff it wasn't set before.
    
    2179
    +      modifySession (hscUpdateHUG (restoreOriginalDynFlags originalHUG)))
    
    1980 2180
         (\_ -> load)
    
    2181
    +  where
    
    2182
    +    deferTypeErrors home_unit_env =
    
    2183
    +      home_unit_env
    
    2184
    +        { homeUnitEnv_dflags =
    
    2185
    +            setGeneralFlag' Opt_DeferTypeErrors (homeUnitEnv_dflags home_unit_env)
    
    2186
    +        }
    
    2187
    +
    
    2188
    +    restoreOriginalDynFlags (HUG.UnitEnvGraph old) (HUG.UnitEnvGraph new) = HUG.UnitEnvGraph $
    
    2189
    +      M.unionWith (\b a ->
    
    2190
    +        a { homeUnitEnv_dflags = homeUnitEnv_dflags b
    
    2191
    +          })
    
    2192
    +        old new
    
    1981 2193
     
    
    1982 2194
     loadModule :: GhciMonad m => [(FilePath, Maybe UnitId, Maybe Phase)] -> m SuccessFlag
    
    1983 2195
     loadModule fs = do
    
    ... ... @@ -1986,7 +2198,7 @@ loadModule fs = do
    1986 2198
     
    
    1987 2199
     -- | @:load@ command
    
    1988 2200
     loadModule_ :: GhciMonad m => [FilePath] -> m ()
    
    1989
    -loadModule_ fs = void $ loadModule (zip3 fs (repeat Nothing) (repeat Nothing))
    
    2201
    +loadModule_ fs = void $ loadModule (zip3 fs (repeat (Just interactiveSessionUnitId)) (repeat Nothing))
    
    1990 2202
     
    
    1991 2203
     loadModuleDefer :: GhciMonad m => [FilePath] -> m ()
    
    1992 2204
     loadModuleDefer = wrapDeferTypeErrors . loadModule_
    
    ... ... @@ -2030,7 +2242,8 @@ addModule :: GhciMonad m => [FilePath] -> m ()
    2030 2242
     addModule files = do
    
    2031 2243
       revertCAFs -- always revert CAFs on load/add.
    
    2032 2244
       files' <- mapM expandPath files
    
    2033
    -  targets <- mapM (\m -> GHC.guessTarget m Nothing Nothing) files'
    
    2245
    +  -- New targets are always added to the 'interactiveSessionUnitId' 'HomeUnitEnv'.
    
    2246
    +  targets <- mapM (\m -> GHC.guessTarget m (Just interactiveSessionUnitId) Nothing) files'
    
    2034 2247
       targets' <- filterM checkTarget targets
    
    2035 2248
       -- remove old targets with the same id; e.g. for :add *M
    
    2036 2249
       mapM_ GHC.removeTarget [ tid | Target { targetId = tid } <- targets' ]
    
    ... ... @@ -2063,7 +2276,8 @@ addModule files = do
    2063 2276
     unAddModule :: GhciMonad m => [FilePath] -> m ()
    
    2064 2277
     unAddModule files = do
    
    2065 2278
       files' <- mapM expandPath files
    
    2066
    -  targets <- mapM (\m -> GHC.guessTarget m Nothing Nothing) files'
    
    2279
    +  -- New targets are always added to the 'interactiveSessionUnitId' 'HomeUnitEnv'.
    
    2280
    +  targets <- mapM (\m -> GHC.guessTarget m (Just interactiveSessionUnitId) Nothing) files'
    
    2067 2281
       let removals = [ tid | Target { targetId = tid } <- targets ]
    
    2068 2282
       mapM_ GHC.removeTarget removals
    
    2069 2283
       _ <- doLoadAndCollectInfo (Unadd $ length removals) LoadAllTargets
    
    ... ... @@ -2102,10 +2316,7 @@ doLoadAndCollectInfo load_type howmuch = do
    2102 2316
       doLoad load_type howmuch >>= \case
    
    2103 2317
         Succeeded | doCollectInfo -> do
    
    2104 2318
           mod_summaries <- GHC.mgModSummaries <$> getModuleGraph
    
    2105
    -      -- MP: :set +c code path only works in single package mode atm, hence
    
    2106
    -      -- this call to isLoaded is ok. collectInfo needs to be modified further to
    
    2107
    -      -- work with :set +c so I have punted on that for now.
    
    2108
    -      loaded <- filterM GHC.isLoaded (map ms_mod_name mod_summaries)
    
    2319
    +      loaded <- filterM GHC.isLoadedHomeModule (map ms_mod mod_summaries)
    
    2109 2320
           v <- mod_infos <$> getGHCiState
    
    2110 2321
           !newInfos <- collectInfo v loaded
    
    2111 2322
           modifyGHCiState (\st -> st { mod_infos = newInfos })
    
    ... ... @@ -2187,7 +2398,7 @@ setContextAfterLoad keep_ctxt (Just graph) = do
    2187 2398
                   -- We import the module with a * iff
    
    2188 2399
                   --   - it is interpreted, and
    
    2189 2400
                   --   - -XSafe is off (it doesn't allow *-imports)
    
    2190
    -        let new_ctx | star_ok   = [mkIIModule (GHC.moduleName m)]
    
    2401
    +        let new_ctx | star_ok   = [mkIIModule m]
    
    2191 2402
                         | otherwise = [mkIIDecl   (GHC.moduleName m)]
    
    2192 2403
             setContextKeepingPackageModules keep_ctxt new_ctx
    
    2193 2404
     
    
    ... ... @@ -2222,9 +2433,10 @@ keepPackageImports = filterM is_pkg_import
    2222 2433
          is_pkg_import (IIDecl d)
    
    2223 2434
              = do pkgqual <- GHC.renameRawPkgQualM mod_name (ideclPkgQual d)
    
    2224 2435
                   e <- MC.try $ GHC.findQualifiedModule pkgqual mod_name
    
    2436
    +              hug <- hsc_HUG <$> GHC.getSession
    
    2225 2437
                   case e :: Either SomeException Module of
    
    2226 2438
                     Left _  -> return False
    
    2227
    -                Right m -> return (not (isMainUnitModule m))
    
    2439
    +                Right m -> return $ not (HUG.memberHugUnit (moduleUnit m) hug)
    
    2228 2440
             where
    
    2229 2441
               mod_name = unLoc (ideclName d)
    
    2230 2442
     
    
    ... ... @@ -2607,7 +2819,7 @@ guessCurrentModule cmd = do
    2607 2819
       imports <- GHC.getContext
    
    2608 2820
       case imports of
    
    2609 2821
         [] -> throwGhcException $ CmdLineError (':' : cmd ++ ": no current module")
    
    2610
    -    IIModule m : _ -> GHC.findQualifiedModule NoPkgQual m
    
    2822
    +    IIModule m : _ -> pure m
    
    2611 2823
         IIDecl d : _ -> do
    
    2612 2824
           pkgqual <- GHC.renameRawPkgQualM (unLoc $ ideclName d) (ideclPkgQual d)
    
    2613 2825
           GHC.findQualifiedModule pkgqual (unLoc (ideclName d))
    
    ... ... @@ -2628,7 +2840,7 @@ browseModule bang modl exports_only = do
    2628 2840
               then pure $ GHC.modInfoExports mod_info
    
    2629 2841
               else do
    
    2630 2842
                 hsc_env <- GHC.getSession
    
    2631
    -            mmod_env <- liftIO $ mkTopLevEnv hsc_env (moduleName modl)
    
    2843
    +            mmod_env <- liftIO $ mkTopLevEnv hsc_env modl
    
    2632 2844
                 case mmod_env of
    
    2633 2845
                   Left err -> throwGhcException (CmdLineError (GHC.moduleNameString (GHC.moduleName modl) ++ " " ++ err))
    
    2634 2846
                   Right mod_env -> pure $ map greName . globalRdrEnvElts $ mod_env
    
    ... ... @@ -2737,8 +2949,9 @@ addModulesToContext starred unstarred = restoreContextOnFailure $ do
    2737 2949
     
    
    2738 2950
     addModulesToContext_ :: GhciMonad m => [ModuleName] -> [ModuleName] -> m ()
    
    2739 2951
     addModulesToContext_ starred unstarred = do
    
    2740
    -   mapM_ addII (map mkIIModule starred ++ map mkIIDecl unstarred)
    
    2741
    -   setGHCContextFromGHCiState
    
    2952
    +  starredModules <- traverse lookupModuleName starred
    
    2953
    +  mapM_ addII (map mkIIModule starredModules ++ map mkIIDecl unstarred)
    
    2954
    +  setGHCContextFromGHCiState
    
    2742 2955
     
    
    2743 2956
     remModulesFromContext :: GhciMonad m => [ModuleName] -> [ModuleName] -> m ()
    
    2744 2957
     remModulesFromContext  starred unstarred = do
    
    ... ... @@ -2804,14 +3017,14 @@ checkAdd ii = do
    2804 3017
       dflags <- getDynFlags
    
    2805 3018
       let safe = safeLanguageOn dflags
    
    2806 3019
       case ii of
    
    2807
    -    IIModule modname
    
    3020
    +    IIModule mod
    
    2808 3021
            | safe -> throwGhcException $ CmdLineError "can't use * imports with Safe Haskell"
    
    2809
    -       | otherwise -> wantInterpretedModuleName modname >> return ()
    
    3022
    +       | otherwise -> checkInterpretedModule mod >> return ()
    
    2810 3023
     
    
    2811 3024
         IIDecl d -> do
    
    2812 3025
            let modname = unLoc (ideclName d)
    
    2813 3026
            pkgqual <- GHC.renameRawPkgQualM modname (ideclPkgQual d)
    
    2814
    -       m <- GHC.lookupQualifiedModule pkgqual modname
    
    3027
    +       m <- lookupQualifiedModuleName pkgqual modname
    
    2815 3028
            when safe $ do
    
    2816 3029
                t <- GHC.isModuleTrusted m
    
    2817 3030
                unless t $ throwGhcException $ ProgramError $ ""
    
    ... ... @@ -2874,13 +3087,13 @@ getImplicitPreludeImports iidecls = do
    2874 3087
     -- -----------------------------------------------------------------------------
    
    2875 3088
     -- Utils on InteractiveImport
    
    2876 3089
     
    
    2877
    -mkIIModule :: ModuleName -> InteractiveImport
    
    3090
    +mkIIModule :: Module -> InteractiveImport
    
    2878 3091
     mkIIModule = IIModule
    
    2879 3092
     
    
    2880 3093
     mkIIDecl :: ModuleName -> InteractiveImport
    
    2881 3094
     mkIIDecl = IIDecl . simpleImportDecl
    
    2882 3095
     
    
    2883
    -iiModules :: [InteractiveImport] -> [ModuleName]
    
    3096
    +iiModules :: [InteractiveImport] -> [Module]
    
    2884 3097
     iiModules is = [m | IIModule m <- is]
    
    2885 3098
     
    
    2886 3099
     isIIModule :: InteractiveImport -> Bool
    
    ... ... @@ -2888,7 +3101,7 @@ isIIModule (IIModule _) = True
    2888 3101
     isIIModule _ = False
    
    2889 3102
     
    
    2890 3103
     iiModuleName :: InteractiveImport -> ModuleName
    
    2891
    -iiModuleName (IIModule m) = m
    
    3104
    +iiModuleName (IIModule m) = moduleName m
    
    2892 3105
     iiModuleName (IIDecl d)   = unLoc (ideclName d)
    
    2893 3106
     
    
    2894 3107
     preludeModuleName :: ModuleName
    
    ... ... @@ -2990,8 +3203,23 @@ showOptions show_all
    2990 3203
                        then text "none."
    
    2991 3204
                        else hsep (map (\o -> char '+' <> text (optToStr o)) opts)
    
    2992 3205
                ))
    
    2993
    -       liftIO $ showDynFlags show_all dflags
    
    2994
    -
    
    3206
    +       mapNonInteractiveHomeUnitsM (liftIO . showDynFlags show_all)
    
    3207
    +
    
    3208
    +mapNonInteractiveHomeUnitsM :: GHC.GhcMonad m => (DynFlags -> m ()) -> m ()
    
    3209
    +mapNonInteractiveHomeUnitsM printer = do
    
    3210
    +  hug <- hsc_HUG <$> GHC.getSession
    
    3211
    +  singleOrMultipleHomeUnits
    
    3212
    +      $ map (\(uid, homeUnit) -> (uid, homeUnitEnv_dflags homeUnit))
    
    3213
    +      $ filter (\(uid, _) -> uid /= interactiveSessionUnitId
    
    3214
    +                          && uid /= interactiveGhciUnitId)
    
    3215
    +      $ HUG.unitEnv_assocs hug
    
    3216
    +  where
    
    3217
    +    singleOrMultipleHomeUnits [] =
    
    3218
    +      liftIO $ putStrLn "GHCi: internal error - no home unit configured"
    
    3219
    +    singleOrMultipleHomeUnits [(_, dflags)] = printer dflags
    
    3220
    +    singleOrMultipleHomeUnits xs = mapM_ (\(uid, dflags) -> do
    
    3221
    +      liftIO $ putStrLn (showSDoc dflags (text "Unit ID:" <+> ppr uid))
    
    3222
    +      printer dflags) xs
    
    2995 3223
     
    
    2996 3224
     showDynFlags :: Bool -> DynFlags -> IO ()
    
    2997 3225
     showDynFlags show_all dflags = do
    
    ... ... @@ -3117,69 +3345,206 @@ setOptions wds =
    3117 3345
           -- then, dynamic flags
    
    3118 3346
           when (not (null minus_opts)) $ newDynFlags False minus_opts
    
    3119 3347
     
    
    3120
    --- | newDynFlags will *not* read package environment files, therefore we
    
    3121
    --- use 'parseDynamicFlagsCmdLine' rather than 'parseDynamicFlags'. This
    
    3122
    --- function is called very often and results in repeatedly loading
    
    3123
    --- environment files (see #19650)
    
    3348
    +-- Note [No unused package warnings for the interactive session]
    
    3349
    +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    
    3350
    +--
    
    3351
    +-- The interactive session (also called "interactive-prompt" occassionally) should not
    
    3352
    +-- report unused packages, as it will essentially always report packages
    
    3353
    +-- as unused.
    
    3354
    +-- The "interactive-prompt" doesn't contain any 'Module's, so most packages
    
    3355
    +-- are unused.
    
    3356
    +-- As this would flood the user with warnings they can't do anything about,
    
    3357
    +-- we decide to unconditionally turn off the warning 'Opt_WarnUnusedPackages'.
    
    3358
    +--
    
    3359
    +-- Unused packages in GHCi are still reported via the 'interactive-session' unit.
    
    3360
    +-- See Note [Multiple Home Units aware GHCi] for an explanation about the
    
    3361
    +-- "interactive-prompt" and 'interactive-session' unit.
    
    3362
    +
    
    3363
    +-- | 'newDynFlags' adds the given user options to the session.
    
    3364
    +--
    
    3365
    +-- If 'True' is passed, we add the options only to the interactive 'DynFlags'.
    
    3366
    +-- Otherwise, the options are added to each 'HomeUnitEnv' in the current session.
    
    3367
    +--
    
    3368
    +-- This function will check whether we need to re-initialise the 'UnitState',
    
    3369
    +-- for example when the user writes ':set -package containers'.
    
    3370
    +--
    
    3371
    +-- Any warnings during parsing, or validation of the new 'DynFlags' will be
    
    3372
    +-- directly reported to the user.
    
    3124 3373
     newDynFlags :: GhciMonad m => Bool -> [String] -> m ()
    
    3125 3374
     newDynFlags interactive_only minus_opts = do
    
    3126
    -      let lopts = map noLoc minus_opts
    
    3375
    +  let lopts = map noLoc minus_opts
    
    3127 3376
     
    
    3128
    -      logger <- getLogger
    
    3129
    -      idflags0 <- GHC.getInteractiveDynFlags
    
    3130
    -      (idflags1, leftovers, warns) <- DynFlags.parseDynamicFlagsCmdLine logger idflags0 lopts
    
    3377
    +  case interactive_only of
    
    3378
    +    True -> addToInteractiveDynFlags lopts
    
    3379
    +    False -> addToProgramDynFlags lopts
    
    3131 3380
     
    
    3132
    -      liftIO $ printOrThrowDiagnostics logger (initPrintConfig idflags1) (initDiagOpts idflags1) (GhcDriverMessage <$> warns)
    
    3381
    +  idflags <- hsc_dflags <$> GHC.getSession
    
    3382
    +  installInteractivePrint (interactivePrint idflags) False
    
    3383
    +
    
    3384
    +-- | Add the given options to the interactive 'DynFlags'.
    
    3385
    +-- This function will normalise and validate the 'DynFlags' and report warnings
    
    3386
    +-- directly to the user.
    
    3387
    +--
    
    3388
    +-- Updates both the 'hsc_dflags' of 'HscEnv', and the 'ic_dflags' of the 'InteractiveContext'.
    
    3389
    +--
    
    3390
    +-- 'addToInteractiveDynFlags' will *not* read package environment files, therefore we
    
    3391
    +-- use 'parseDynamicFlagsCmdLine' rather than 'parseDynamicFlags'. This
    
    3392
    +-- function is called very often and results in repeatedly loading
    
    3393
    +-- environment files (see #19650)
    
    3394
    +addToInteractiveDynFlags :: GhciMonad m => [Located String] -> m ()
    
    3395
    +addToInteractiveDynFlags lopts = do
    
    3396
    +  logger <- getLogger
    
    3397
    +  env <- GHC.getSession
    
    3398
    +  let idflags0 = hsc_dflags env
    
    3399
    +  (idflags1, leftovers, warns) <- DynFlags.parseDynamicFlagsCmdLine logger idflags0 lopts
    
    3400
    +
    
    3401
    +  liftIO $ printOrThrowDiagnostics logger (initPrintConfig idflags1) (initDiagOpts idflags1) (GhcDriverMessage <$> warns)
    
    3402
    +  when (not $ null leftovers) (unknownFlagsErr $ map unLoc leftovers)
    
    3403
    +
    
    3404
    +  when (packageFlagsChanged idflags1 idflags0) $ do
    
    3405
    +    liftIO $ hPutStrLn stderr "cannot set package flags with :seti; use :set"
    
    3406
    +
    
    3407
    +  idflags_norm <- GHC.normaliseInteractiveDynFlags logger idflags1
    
    3408
    +  -- Strictly speaking, 'setProgramHUG' performs more work than necessary,
    
    3409
    +  -- as we know the majority of flags haven't changed.
    
    3410
    +  _ <- GHC.setProgramHUG (hsc_HUG $ hscSetFlags idflags_norm env)
    
    3411
    +  -- Initialise the Interactive DynFlags.
    
    3412
    +  -- Sets the 'ic_dflags' and initialises the 'ic_plugins'.
    
    3413
    +  -- See Note [Relation between the 'InteractiveContext' and 'interactiveGhciUnitId']
    
    3414
    +  idflags <- hsc_dflags <$> GHC.getSession
    
    3415
    +  modifySessionM (GHC.initialiseInteractiveDynFlags idflags)
    
    3416
    +
    
    3417
    +-- | Add the given options to all 'DynFlags' in the 'HomeUnitGraph'.
    
    3418
    +-- This function will validate the 'DynFlags' and report warnings directly to the user.
    
    3419
    +--
    
    3420
    +-- We additionally normalise the 'DynFlags' for the 'interactiveGhciUnitId' for use
    
    3421
    +-- in the 'InteractiveContext'.
    
    3422
    +--
    
    3423
    +-- 'addToProgramDynFlags' will *not* read package environment files, therefore we
    
    3424
    +-- use 'parseDynamicFlagsCmdLine' rather than 'parseDynamicFlags'. This
    
    3425
    +-- function is called very often and results in repeatedly loading
    
    3426
    +-- environment files (see #19650)
    
    3427
    +addToProgramDynFlags :: GhciMonad m => [Located String] -> m ()
    
    3428
    +addToProgramDynFlags lopts = do
    
    3429
    +  logger <- getLogger
    
    3430
    +  initial_hug <- hsc_HUG <$> GHC.getSession
    
    3431
    +  -- Update the 'DynFlags' of each 'HomeUnitEnv'.
    
    3432
    +  -- Parse the new 'DynFlags', and report potential issues once.
    
    3433
    +  -- Arguably, we may want to report issues for each non-builtin 'HomeUnitEnv'
    
    3434
    +  -- individually.
    
    3435
    +  updates <- HUG.unitEnv_traverseWithKey (\uid homeUnitEnv -> do
    
    3436
    +    let oldFlags = HUG.homeUnitEnv_dflags homeUnitEnv
    
    3437
    +    (newFlags, leftovers, warns) <- DynFlags.parseDynamicFlagsCmdLine logger oldFlags lopts
    
    3438
    +    -- We only want to report inconsistencies and warnings once.
    
    3439
    +    -- Thus, we do it only once for the 'interactiveGhciUnitId'
    
    3440
    +    when (uid == interactiveGhciUnitId) $ do
    
    3441
    +      liftIO $ printOrThrowDiagnostics logger (initPrintConfig newFlags) (initDiagOpts newFlags) (GhcDriverMessage <$> warns)
    
    3133 3442
           when (not $ null leftovers) (unknownFlagsErr $ map unLoc leftovers)
    
    3134 3443
     
    
    3135
    -      when (interactive_only && packageFlagsChanged idflags1 idflags0) $ do
    
    3136
    -          liftIO $ hPutStrLn stderr "cannot set package flags with :seti; use :set"
    
    3137
    -      GHC.setInteractiveDynFlags idflags1
    
    3138
    -      installInteractivePrint (interactivePrint idflags1) False
    
    3139
    -
    
    3140
    -      dflags0 <- getDynFlags
    
    3141
    -
    
    3142
    -      when (not interactive_only) $ do
    
    3143
    -        (dflags1, _, _) <- liftIO $ DynFlags.parseDynamicFlagsCmdLine logger dflags0 lopts
    
    3144
    -        must_reload <- GHC.setProgramDynFlags dflags1
    
    3145
    -
    
    3146
    -        -- if the package flags changed, reset the context and link
    
    3147
    -        -- the new packages.
    
    3148
    -        hsc_env <- GHC.getSession
    
    3149
    -        let dflags2 = hsc_dflags hsc_env
    
    3150
    -        let interp  = hscInterp hsc_env
    
    3151
    -        when (packageFlagsChanged dflags2 dflags0) $ do
    
    3152
    -          when (verbosity dflags2 > 0) $
    
    3153
    -            liftIO . putStrLn $
    
    3154
    -              "package flags have changed, resetting and loading new packages..."
    
    3155
    -          -- Clear caches and eventually defined breakpoints. (#1620)
    
    3156
    -          clearCaches
    
    3157
    -          when must_reload $ do
    
    3158
    -            let units = preloadUnits (hsc_units hsc_env)
    
    3159
    -            liftIO $ Loader.loadPackages interp hsc_env units
    
    3160
    -          -- package flags changed, we can't re-use any of the old context
    
    3161
    -          setContextAfterLoad False Nothing
    
    3162
    -          -- and copy the package flags to the interactive DynFlags
    
    3163
    -          idflags <- GHC.getInteractiveDynFlags
    
    3164
    -          GHC.setInteractiveDynFlags
    
    3165
    -              idflags{ packageFlags = packageFlags dflags2 }
    
    3166
    -
    
    3167
    -        let ld0length   = length $ ldInputs dflags0
    
    3168
    -            fmrk0length = length $ cmdlineFrameworks dflags0
    
    3169
    -
    
    3170
    -            newLdInputs     = drop ld0length (ldInputs dflags2)
    
    3171
    -            newCLFrameworks = drop fmrk0length (cmdlineFrameworks dflags2)
    
    3172
    -
    
    3173
    -            dflags'  = dflags2 { ldInputs = newLdInputs
    
    3174
    -                               , cmdlineFrameworks = newCLFrameworks
    
    3175
    -                               }
    
    3176
    -            hsc_env' = hscSetFlags dflags' hsc_env
    
    3177
    -
    
    3178
    -        when (not (null newLdInputs && null newCLFrameworks)) $
    
    3179
    -          liftIO $ Loader.loadCmdLineLibs (hscInterp hsc_env') hsc_env'
    
    3180
    -
    
    3181
    -      return ()
    
    3444
    +    -- Special Logic!
    
    3445
    +    -- Currently, the interactive 'DynFlags' have additional restrictions,
    
    3446
    +    -- for example modifying package flags is not supported!
    
    3447
    +    -- The interactive 'DynFlags' get normalised to uphold this restriction.
    
    3448
    +    -- As a special precaution, we also don't want to report unusued packages warnings
    
    3449
    +    -- for the interactive session.
    
    3450
    +    -- See Note [No unused package warnings for the interactive session]
    
    3451
    +    --
    
    3452
    +    -- See Note [Multiple Home Units aware GHCi] for details about how
    
    3453
    +    -- the interactive session is structured.
    
    3454
    +    newFlags' <-
    
    3455
    +      if uid == interactiveGhciUnitId
    
    3456
    +        then do
    
    3457
    +          -- See Note [No unused package warnings for the interactive session]
    
    3458
    +          let icdflags1 = wopt_unset newFlags Opt_WarnUnusedPackages
    
    3459
    +          GHC.normaliseInteractiveDynFlags logger icdflags1
    
    3460
    +        else
    
    3461
    +          pure newFlags
    
    3462
    +    pure (homeUnitEnv { homeUnitEnv_dflags = newFlags' })
    
    3463
    +    )
    
    3464
    +    initial_hug
    
    3465
    +  -- Update the HUG!
    
    3466
    +  -- This might force us to reload the 'UnitState' of each 'HomeUnitEnv'
    
    3467
    +  -- if package flags were changed.
    
    3468
    +  must_reload <- GHC.setProgramHUG updates
    
    3469
    +
    
    3470
    +  -- Initialise the Interactive DynFlags.
    
    3471
    +  -- Sets the 'ic_dflags' and initialises the 'ic_plugins'.
    
    3472
    +  -- See Note [Relation between the 'InteractiveContext' and 'interactiveGhciUnitId']
    
    3473
    +  icdflags <- hsc_dflags <$> GHC.getSession
    
    3474
    +  modifySessionM (GHC.initialiseInteractiveDynFlags icdflags)
    
    3475
    +
    
    3476
    +  -- if the package flags changed, reset the context and link
    
    3477
    +  -- the new packages.
    
    3478
    +  hsc_env <- GHC.getSession
    
    3479
    +  let dflags2 = hsc_dflags hsc_env
    
    3480
    +  when must_reload $ do
    
    3481
    +    when (verbosity dflags2 > 0) $
    
    3482
    +      liftIO . putStrLn $
    
    3483
    +        "package flags have changed, resetting and loading new packages..."
    
    3484
    +
    
    3485
    +    -- Clear caches and eventually defined breakpoints. (#1620)
    
    3486
    +    clearCaches
    
    3182 3487
     
    
    3488
    +    reloadPackages hsc_env
    
    3489
    +
    
    3490
    +  reloadLinkerOptions hsc_env initial_hug
    
    3491
    +
    
    3492
    +reloadPackages :: GhciMonad m => HscEnv -> m ()
    
    3493
    +reloadPackages hsc_env = do
    
    3494
    +  let
    
    3495
    +      units =
    
    3496
    +        concatMap (preloadUnits . HUG.homeUnitEnv_units)
    
    3497
    +                  (Foldable.toList $ hsc_HUG hsc_env)
    
    3498
    +  liftIO $ Loader.loadPackages (hscInterp hsc_env) hsc_env units
    
    3499
    +  -- package flags changed, we can't re-use any of the old context
    
    3500
    +  setContextAfterLoad False Nothing
    
    3501
    +
    
    3502
    +-- | Reload the linker options.
    
    3503
    +--
    
    3504
    +-- Synopsis: @'reloadLinkerOptions' hsc_env old_hug@
    
    3505
    +--
    
    3506
    +-- After the HUG is modified, the linker may need to be reloaded.
    
    3507
    +-- The linker is reloaded via 'loadCmdLineLibs', if the library inputs
    
    3508
    +-- have changed.
    
    3509
    +-- To determine whether the library inputs have changed, we need the
    
    3510
    +-- old HUG, which is passed as the argument 'old_hug'.
    
    3511
    +--
    
    3512
    +-- This function will crash, if the 'old_hug' doesn't have exactly
    
    3513
    +-- the same keys has the given 'hsc_env'. I.e.
    
    3514
    +--
    
    3515
    +-- @
    
    3516
    +--   HUG.unitEnv_keys old_hug == HUG.unitEnv_keys (hsc_HUG hsc_env)
    
    3517
    +-- @
    
    3518
    +reloadLinkerOptions :: MonadIO m => HscEnv -> HomeUnitGraph -> m ()
    
    3519
    +reloadLinkerOptions hsc_env old_hug = do
    
    3520
    +  let
    
    3521
    +    new_hug = hsc_HUG hsc_env
    
    3522
    +  let
    
    3523
    +    (needs_updates, updated_hug) = HUG.unitEnv_traverseWithKey (\key unitEnv ->
    
    3524
    +      let
    
    3525
    +        old_flags = homeUnitEnv_dflags (HUG.unitEnv_lookup key old_hug)
    
    3526
    +        new_flags = homeUnitEnv_dflags unitEnv
    
    3527
    +        ld0length   = length $ ldInputs old_flags
    
    3528
    +        fmrk0length = length $ cmdlineFrameworks old_flags
    
    3529
    +
    
    3530
    +        newLdInputs     = drop ld0length (ldInputs new_flags)
    
    3531
    +        newCLFrameworks = drop fmrk0length (cmdlineFrameworks new_flags)
    
    3532
    +
    
    3533
    +        dflags' = new_flags { ldInputs = newLdInputs
    
    3534
    +                            , cmdlineFrameworks = newCLFrameworks
    
    3535
    +                            }
    
    3536
    +      in
    
    3537
    +        (S.Any (not (null newLdInputs && null newCLFrameworks)),
    
    3538
    +           unitEnv { homeUnitEnv_dflags = dflags' })
    
    3539
    +      ) new_hug
    
    3540
    +
    
    3541
    +    hsc_env' =
    
    3542
    +      hscSetActiveUnitId (hscActiveUnitId hsc_env)
    
    3543
    +      $ hscUpdateHUG (const updated_hug)
    
    3544
    +      $ hsc_env
    
    3545
    +
    
    3546
    +  when (S.getAny needs_updates) $
    
    3547
    +    liftIO $ Loader.loadCmdLineLibs (hscInterp hsc_env') hsc_env'
    
    3183 3548
     
    
    3184 3549
     unknownFlagsErr :: GhciMonad m => [String] -> m ()
    
    3185 3550
     unknownFlagsErr fs = mapM_ (\f -> reportError (GhciUnknownFlag f (suggestions f))) fs
    
    ... ... @@ -3261,7 +3626,6 @@ showCmd "" = showOptions False
    3261 3626
     showCmd "-a" = showOptions True
    
    3262 3627
     showCmd str = do
    
    3263 3628
         st <- getGHCiState
    
    3264
    -    dflags <- getDynFlags
    
    3265 3629
         hsc_env <- GHC.getSession
    
    3266 3630
     
    
    3267 3631
         let lookupCmd :: String -> Maybe (m ())
    
    ... ... @@ -3299,8 +3663,10 @@ showCmd str = do
    3299 3663
         case words str of
    
    3300 3664
           [w] | Just action <- lookupCmd w -> action
    
    3301 3665
     
    
    3302
    -      _ -> let helpCmds = [ text name | (True, name, _) <- cmds ]
    
    3303
    -           in throwGhcException $ CmdLineError $ showSDoc dflags
    
    3666
    +      _ -> do
    
    3667
    +        let helpCmds = [ text name | (True, name, _) <- cmds ]
    
    3668
    +        dflags <- getDynFlags
    
    3669
    +        throwGhcException $ CmdLineError $ showSDoc dflags
    
    3304 3670
                   $ hang (text "syntax:") 4
    
    3305 3671
                   $ hang (text ":show") 6
    
    3306 3672
                   $ brackets (fsep $ punctuate (text " |") helpCmds)
    
    ... ... @@ -3321,7 +3687,7 @@ showImports = do
    3321 3687
           trans_ctx = transient_ctx st
    
    3322 3688
     
    
    3323 3689
           show_one (IIModule star_m)
    
    3324
    -          = ":module +*" ++ moduleNameString star_m
    
    3690
    +          = ":module +*" ++ moduleNameString (moduleName star_m)
    
    3325 3691
           show_one (IIDecl imp) = showPpr dflags imp
    
    3326 3692
     
    
    3327 3693
       prel_iidecls <- getImplicitPreludeImports (rem_ctx ++ trans_ctx)
    
    ... ... @@ -3427,16 +3793,14 @@ pprStopped res =
    3427 3793
       mb_mod_name = moduleName <$> ibi_tick_mod <$> GHC.resumeBreakpointId res
    
    3428 3794
     
    
    3429 3795
     showUnits :: GHC.GhcMonad m => m ()
    
    3430
    -showUnits = do
    
    3431
    -  dflags <- getDynFlags
    
    3796
    +showUnits = mapNonInteractiveHomeUnitsM $ \dflags -> do
    
    3432 3797
       let pkg_flags = packageFlags dflags
    
    3433 3798
       liftIO $ putStrLn $ showSDoc dflags $
    
    3434 3799
         text ("active package flags:"++if null pkg_flags then " none" else "") $$
    
    3435 3800
           nest 2 (vcat (map pprFlag pkg_flags))
    
    3436 3801
     
    
    3437 3802
     showPaths :: GHC.GhcMonad m => m ()
    
    3438
    -showPaths = do
    
    3439
    -  dflags <- getDynFlags
    
    3803
    +showPaths = mapNonInteractiveHomeUnitsM $ \dflags -> do
    
    3440 3804
       liftIO $ do
    
    3441 3805
         cwd <- getCurrentDirectory
    
    3442 3806
         putStrLn $ showSDoc dflags $
    
    ... ... @@ -3448,7 +3812,7 @@ showPaths = do
    3448 3812
             nest 2 (vcat (map text ipaths))
    
    3449 3813
     
    
    3450 3814
     showLanguages :: GHC.GhcMonad m => m ()
    
    3451
    -showLanguages = getDynFlags >>= liftIO . showLanguages' False
    
    3815
    +showLanguages = mapNonInteractiveHomeUnitsM $ liftIO . showLanguages' False
    
    3452 3816
     
    
    3453 3817
     showiLanguages :: GHC.GhcMonad m => m ()
    
    3454 3818
     showiLanguages = GHC.getInteractiveDynFlags >>= liftIO . showLanguages' False
    
    ... ... @@ -3627,11 +3991,11 @@ completeBreakpoint = wrapCompleter spaces $ \w -> do -- #3000
    3627 3991
             filterM GHC.moduleIsInterpreted hmods
    
    3628 3992
     
    
    3629 3993
         -- Return all possible bids for a given Module
    
    3630
    -    bidsByModule :: GhciMonad m => [ModuleName] -> Module -> m [String]
    
    3994
    +    bidsByModule :: GhciMonad m => [Module] -> Module -> m [String]
    
    3631 3995
         bidsByModule nonquals mod = do
    
    3632 3996
           (_, decls) <- getModBreak mod
    
    3633 3997
           let bids = nub $ declPath <$> elems decls
    
    3634
    -      pure $ case (moduleName mod) `elem` nonquals of
    
    3998
    +      pure $ case mod `elem` nonquals of
    
    3635 3999
                   True  -> bids
    
    3636 4000
                   False -> (combineModIdent (showModule mod)) <$> bids
    
    3637 4001
     
    
    ... ... @@ -4036,8 +4400,7 @@ breakSwitch (arg1:rest)
    4036 4400
        | all isDigit arg1 = do
    
    4037 4401
             imports <- GHC.getContext
    
    4038 4402
             case iiModules imports of
    
    4039
    -           (mn : _) -> do
    
    4040
    -              md <- lookupModuleName mn
    
    4403
    +           (md : _) -> do
    
    4041 4404
                   breakByModuleLine md (read arg1) rest
    
    4042 4405
                [] -> do
    
    4043 4406
                   liftIO $ putStrLn "No modules are loaded with debugging support."
    
    ... ... @@ -4169,8 +4532,7 @@ list2 [arg] | all isDigit arg = do
    4169 4532
         case iiModules imports of
    
    4170 4533
             [] -> liftIO $ putStrLn "No module to list"
    
    4171 4534
             (mn : _) -> do
    
    4172
    -          md <- lookupModuleName mn
    
    4173
    -          listModuleLine md (read arg)
    
    4535
    +          listModuleLine mn (read arg)
    
    4174 4536
     list2 [arg1,arg2] | looksLikeModuleName arg1, all isDigit arg2 = do
    
    4175 4537
             md <- wantInterpretedModule arg1
    
    4176 4538
             listModuleLine md (read arg2)
    
    ... ... @@ -4426,10 +4788,20 @@ lookupModule :: GHC.GhcMonad m => String -> m Module
    4426 4788
     lookupModule mName = lookupModuleName (GHC.mkModuleName mName)
    
    4427 4789
     
    
    4428 4790
     lookupModuleName :: GHC.GhcMonad m => ModuleName -> m Module
    
    4429
    -lookupModuleName mName = GHC.lookupQualifiedModule NoPkgQual mName
    
    4430
    -
    
    4431
    -isMainUnitModule :: Module -> Bool
    
    4432
    -isMainUnitModule m = GHC.moduleUnit m == mainUnit
    
    4791
    +lookupModuleName mName = lookupQualifiedModuleName NoPkgQual mName
    
    4792
    +
    
    4793
    +lookupQualifiedModuleName :: GHC.GhcMonad m => PkgQual -> ModuleName -> m Module
    
    4794
    +lookupQualifiedModuleName qual modl = do
    
    4795
    +  GHC.lookupAllQualifiedModuleNames qual modl >>= \case
    
    4796
    +    [] -> throwGhcException (CmdLineError ("module '" ++ str ++ "' could not be found."))
    
    4797
    +    [m] -> pure m
    
    4798
    +    ms -> throwGhcException (CmdLineError ("module name '" ++ str ++ "' is ambiguous:\n" ++ errorMsg ms))
    
    4799
    +  where
    
    4800
    +    str = moduleNameString modl
    
    4801
    +    errorMsg ms = intercalate "\n"
    
    4802
    +      [ "- " ++ unitIdString (toUnitId (moduleUnit m)) ++ ":" ++ moduleNameString (moduleName m)
    
    4803
    +      | m <- ms
    
    4804
    +      ]
    
    4433 4805
     
    
    4434 4806
     showModule :: Module -> String
    
    4435 4807
     showModule = moduleNameString . moduleName
    
    ... ... @@ -4476,15 +4848,19 @@ wantInterpretedModule str = wantInterpretedModuleName (GHC.mkModuleName str)
    4476 4848
     
    
    4477 4849
     wantInterpretedModuleName :: GHC.GhcMonad m => ModuleName -> m Module
    
    4478 4850
     wantInterpretedModuleName modname = do
    
    4479
    -   modl <- lookupModuleName modname
    
    4480
    -   let str = moduleNameString modname
    
    4481
    -   home_unit <- hsc_home_unit <$> GHC.getSession
    
    4482
    -   unless (isHomeModule home_unit modl) $
    
    4483
    -      throwGhcException (CmdLineError ("module '" ++ str ++ "' is from another package;\nthis command requires an interpreted module"))
    
    4484
    -   is_interpreted <- GHC.moduleIsInterpreted modl
    
    4485
    -   when (not is_interpreted) $
    
    4486
    -       throwGhcException (CmdLineError ("module '" ++ str ++ "' is not interpreted; try \':add *" ++ str ++ "' first"))
    
    4487
    -   return modl
    
    4851
    +  modl <- lookupModuleName modname
    
    4852
    +  checkInterpretedModule modl
    
    4853
    +
    
    4854
    +checkInterpretedModule :: GHC.GhcMonad m => Module -> m Module
    
    4855
    +checkInterpretedModule modl = do
    
    4856
    +  let str = moduleNameString $ moduleName modl
    
    4857
    +  hug <- hsc_HUG <$> GHC.getSession
    
    4858
    +  unless (HUG.memberHugUnit (moduleUnit modl) hug) $
    
    4859
    +    throwGhcException (CmdLineError ("module '" ++ str ++ "' is from another package;\nthis command requires an interpreted module"))
    
    4860
    +  is_interpreted <- GHC.moduleIsInterpreted modl
    
    4861
    +  when (not is_interpreted) $
    
    4862
    +      throwGhcException (CmdLineError ("module '" ++ str ++ "' is not interpreted; try \':add *" ++ str ++ "' first"))
    
    4863
    +  return modl
    
    4488 4864
     
    
    4489 4865
     wantNameFromInterpretedModule :: GHC.GhcMonad m
    
    4490 4866
                                   => (Name -> SDoc -> m ())
    

  • ghc/GHCi/UI/Exception.hs
    ... ... @@ -465,7 +465,7 @@ instance DiagnosticCodeNameSpace GHCi where
    465 465
     
    
    466 466
     type GhciDiagnosticCode :: Symbol -> Nat
    
    467 467
     type family GhciDiagnosticCode c = n | n -> c where
    
    468
    -  GhciDiagnosticCode "GhciCommandNotSupportedInMultiMode" = 83514
    
    468
    +  GhciDiagnosticCode "GhciCommandNotSupportedInMultiMode" = Outdated 83514
    
    469 469
       GhciDiagnosticCode "GhciInvalidArgumentString"          = 68894
    
    470 470
       GhciDiagnosticCode "GhciCommandSyntaxError"             = 72682
    
    471 471
       GhciDiagnosticCode "GhciInvalidPromptString"            = 50882
    

  • ghc/GHCi/UI/Info.hs
    ... ... @@ -113,7 +113,7 @@ srcSpanFilePath = unpackFS . srcSpanFile
    113 113
     -- | Try to find the location of the given identifier at the given
    
    114 114
     -- position in the module.
    
    115 115
     findLoc :: GhcMonad m
    
    116
    -        => Map ModuleName ModInfo
    
    116
    +        => Map Module ModInfo
    
    117 117
             -> RealSrcSpan
    
    118 118
             -> String
    
    119 119
             -> ExceptT GhciModuleError m (ModInfo,Name,SrcSpan)
    
    ... ... @@ -133,7 +133,7 @@ findLoc infos span0 string = do
    133 133
     
    
    134 134
     -- | Find any uses of the given identifier in the codebase.
    
    135 135
     findNameUses :: (GhcMonad m)
    
    136
    -             => Map ModuleName ModInfo
    
    136
    +             => Map Module ModInfo
    
    137 137
                  -> RealSrcSpan
    
    138 138
                  -> String
    
    139 139
                  -> ExceptT GhciModuleError m [SrcSpan]
    
    ... ... @@ -160,7 +160,7 @@ stripSurrounding xs = filter (not . isRedundant) xs
    160 160
     -- | Try to resolve the name located at the given position, or
    
    161 161
     -- otherwise resolve based on the current module's scope.
    
    162 162
     findName :: GhcMonad m
    
    163
    -         => Map ModuleName ModInfo
    
    163
    +         => Map Module ModInfo
    
    164 164
              -> RealSrcSpan
    
    165 165
              -> ModInfo
    
    166 166
              -> String
    
    ... ... @@ -186,11 +186,11 @@ findName infos span0 mi string =
    186 186
     
    
    187 187
     -- | Try to resolve the name from another (loaded) module's exports.
    
    188 188
     resolveNameFromModule :: GhcMonad m
    
    189
    -                      => Map ModuleName ModInfo
    
    189
    +                      => Map Module ModInfo
    
    190 190
                           -> Name
    
    191 191
                           -> ExceptT GhciModuleError m Name
    
    192 192
     resolveNameFromModule infos name = do
    
    193
    -     info <- maybe (throwE $ GhciNoModuleForName name) pure (nameModule_maybe name >>= \modL -> M.lookup (moduleName modL) infos)
    
    193
    +     info <- maybe (throwE $ GhciNoModuleForName name) pure (nameModule_maybe name >>= \modL -> M.lookup modL infos)
    
    194 194
          let all_names = modInfo_rdrs info
    
    195 195
          maybe (throwE GhciNoMatchingModuleExport) pure $
    
    196 196
              find (matchName name) all_names
    
    ... ... @@ -206,7 +206,7 @@ resolveName spans' si = listToMaybe $ mapMaybe spaninfoVar $
    206 206
     
    
    207 207
     -- | Try to find the type of the given span.
    
    208 208
     findType :: GhcMonad m
    
    209
    -         => Map ModuleName ModInfo
    
    209
    +         => Map Module ModInfo
    
    210 210
              -> RealSrcSpan
    
    211 211
              -> String
    
    212 212
              -> ExceptT GhciModuleError m (ModInfo, Type)
    
    ... ... @@ -228,34 +228,36 @@ findType infos span0 string = do
    228 228
     
    
    229 229
     -- | Guess a module name from a file path.
    
    230 230
     guessModule :: GhcMonad m
    
    231
    -            => Map ModuleName ModInfo -> FilePath -> MaybeT m ModuleName
    
    231
    +            => Map Module ModInfo -> FilePath -> MaybeT m Module
    
    232 232
     guessModule infos fp = do
    
    233
    -    target <- lift $ guessTarget fp Nothing Nothing
    
    234
    -    case targetId target of
    
    235
    -        TargetModule mn  -> return mn
    
    233
    +    target <- lift $ guessTargetId fp
    
    234
    +    case target of
    
    235
    +        TargetModule mn  -> MaybeT $ pure $ findModByModuleName mn
    
    236 236
             TargetFile fp' _ -> guessModule' fp'
    
    237 237
       where
    
    238
    -    guessModule' :: GhcMonad m => FilePath -> MaybeT m ModuleName
    
    238
    +    guessModule' :: GhcMonad m => FilePath -> MaybeT m Module
    
    239 239
         guessModule' fp' = case findModByFp fp' of
    
    240 240
             Just mn -> return mn
    
    241 241
             Nothing -> do
    
    242 242
                 fp'' <- liftIO (makeRelativeToCurrentDirectory fp')
    
    243 243
     
    
    244
    -            target' <- lift $ guessTarget fp'' Nothing Nothing
    
    245
    -            case targetId target' of
    
    246
    -                TargetModule mn -> return mn
    
    244
    +            target' <- lift $ guessTargetId fp''
    
    245
    +            case target' of
    
    246
    +                TargetModule mn -> MaybeT . pure $ findModByModuleName mn
    
    247 247
                     _               -> MaybeT . pure $ findModByFp fp''
    
    248 248
     
    
    249
    -    findModByFp :: FilePath -> Maybe ModuleName
    
    249
    +    findModByFp :: FilePath -> Maybe Module
    
    250 250
         findModByFp fp' = fst <$> find ((Just fp' ==) . mifp) (M.toList infos)
    
    251 251
           where
    
    252
    -        mifp :: (ModuleName, ModInfo) -> Maybe FilePath
    
    252
    +        mifp :: (Module, ModInfo) -> Maybe FilePath
    
    253 253
             mifp = ml_hs_file . ms_location . modinfoSummary . snd
    
    254 254
     
    
    255
    +    findModByModuleName :: ModuleName -> Maybe Module
    
    256
    +    findModByModuleName mn = find ((== mn) . moduleName) (M.keys infos)
    
    255 257
     
    
    256 258
     -- | Collect type info data for the loaded modules.
    
    257
    -collectInfo :: (GhcMonad m) => Map ModuleName ModInfo -> [ModuleName]
    
    258
    -               -> m (Map ModuleName ModInfo)
    
    259
    +collectInfo :: (GhcMonad m) => Map Module ModInfo -> [Module]
    
    260
    +               -> m (Map Module ModInfo)
    
    259 261
     collectInfo ms loaded = do
    
    260 262
         df <- getDynFlags
    
    261 263
         unit_state <- hsc_units <$> getSession
    
    ... ... @@ -299,17 +301,17 @@ srcFilePath modSum = fromMaybe obj_fp src_fp
    299 301
             ms_loc = ms_location modSum
    
    300 302
     
    
    301 303
     -- | Get info about the module: summary, types, etc.
    
    302
    -getModInfo :: (GhcMonad m) => ModuleName -> m ModInfo
    
    303
    -getModInfo name = do
    
    304
    -    m <- getModSummary name
    
    305
    -    p <- parseModule m
    
    304
    +getModInfo :: (GhcMonad m) => Module -> m ModInfo
    
    305
    +getModInfo m = do
    
    306
    +    mod_summary <- getModSummary m
    
    307
    +    p <- parseModule mod_summary
    
    306 308
         typechecked <- typecheckModule p
    
    307 309
         let allTypes = processAllTypeCheckedModule typechecked
    
    308 310
         let !rdr_env = tcg_rdr_env (fst $ tm_internals_ typechecked)
    
    309
    -    ts <- liftIO $ getModificationTime $ srcFilePath m
    
    311
    +    ts <- liftIO $ getModificationTime $ srcFilePath mod_summary
    
    310 312
         return $
    
    311 313
           ModInfo
    
    312
    -        { modinfoSummary    = m
    
    314
    +        { modinfoSummary    = mod_summary
    
    313 315
             , modinfoSpans      = allTypes
    
    314 316
             , modinfoRdrEnv     = forceGlobalRdrEnv rdr_env
    
    315 317
             , modinfoLastUpdate = ts
    

  • ghc/GHCi/UI/Monad.hs
    ... ... @@ -91,7 +91,6 @@ data GHCiState = GHCiState
    91 91
             prompt_cont    :: PromptFunction,
    
    92 92
             editor         :: String,
    
    93 93
             stop           :: String,
    
    94
    -        multiMode      :: Bool,
    
    95 94
             localConfig    :: LocalConfigBehaviour,
    
    96 95
             options        :: [GHCiOption],
    
    97 96
             line_number    :: !Int,         -- ^ input line
    
    ... ... @@ -155,7 +154,7 @@ data GHCiState = GHCiState
    155 154
             long_help  :: String,
    
    156 155
             lastErrorLocations :: IORef [(FastString, Int)],
    
    157 156
     
    
    158
    -        mod_infos  :: !(Map ModuleName ModInfo),
    
    157
    +        mod_infos  :: !(Map Module ModInfo),
    
    159 158
     
    
    160 159
             flushStdHandles :: ForeignHValue,
    
    161 160
                 -- ^ @hFlush stdout; hFlush stderr@ in the interpreter
    

  • ghc/Main.hs
    ... ... @@ -302,7 +302,8 @@ ghciUI units srcs maybe_expr = do
    302 302
             [] -> return []
    
    303 303
             _  -> do
    
    304 304
               s <- initMake srcs
    
    305
    -          return $ map (uncurry (,Nothing,)) s
    
    305
    +          dflags <- getDynFlags
    
    306
    +          return $ map (uncurry (,Just $ homeUnitId_ dflags,)) s
    
    306 307
       interactiveUI defaultGhciSettings hs_srcs maybe_expr
    
    307 308
     #endif
    
    308 309
     
    

  • testsuite/tests/linters/notes.stdout
    ... ... @@ -6,33 +6,33 @@ ref compiler/GHC/Core/Opt/Simplify/Iteration.hs:2556:55: Note [Plan (AFTE
    6 6
     ref    compiler/GHC/Core/Opt/Simplify/Iteration.hs:2985:13:     Note [Case binder next]
    
    7 7
     ref    compiler/GHC/Core/Opt/Simplify/Iteration.hs:4345:8:     Note [Lambda-bound unfoldings]
    
    8 8
     ref    compiler/GHC/Core/Opt/Simplify/Utils.hs:1387:37:     Note [Gentle mode]
    
    9
    -ref    compiler/GHC/Core/Opt/Specialise.hs:1761:29:     Note [Arity decrease]
    
    9
    +ref    compiler/GHC/Core/Opt/Specialise.hs:1758:29:     Note [Arity decrease]
    
    10 10
     ref    compiler/GHC/Core/TyCo/Rep.hs:1783:31:     Note [What prevents a constraint from floating]
    
    11
    -ref    compiler/GHC/Driver/DynFlags.hs:1218:52:     Note [Eta-reduction in -O0]
    
    12
    -ref    compiler/GHC/Driver/Main.hs:1901:34:     Note [simpleTidyPgm - mkBootModDetailsTc]
    
    11
    +ref    compiler/GHC/Driver/DynFlags.hs:1217:52:     Note [Eta-reduction in -O0]
    
    12
    +ref    compiler/GHC/Driver/Main.hs:1886:34:     Note [simpleTidyPgm - mkBootModDetailsTc]
    
    13 13
     ref    compiler/GHC/Hs/Expr.hs:189:63:     Note [Pending Splices]
    
    14
    -ref    compiler/GHC/Hs/Expr.hs:2194:87:     Note [Lifecycle of a splice]
    
    15
    -ref    compiler/GHC/Hs/Expr.hs:2230:7:     Note [Pending Splices]
    
    16
    -ref    compiler/GHC/Hs/Extension.hs:148:5:     Note [Strict argument type constraints]
    
    14
    +ref    compiler/GHC/Hs/Expr.hs:2208:87:     Note [Lifecycle of a splice]
    
    15
    +ref    compiler/GHC/Hs/Expr.hs:2244:7:     Note [Pending Splices]
    
    16
    +ref    compiler/GHC/Hs/Extension.hs:151:5:     Note [Strict argument type constraints]
    
    17 17
     ref    compiler/GHC/Hs/Pat.hs:151:74:     Note [Lifecycle of a splice]
    
    18 18
     ref    compiler/GHC/HsToCore/Pmc/Solver.hs:860:20:     Note [COMPLETE sets on data families]
    
    19 19
     ref    compiler/GHC/HsToCore/Quote.hs:1533:7:     Note [How brackets and nested splices are handled]
    
    20 20
     ref    compiler/GHC/Stg/Unarise.hs:457:32:     Note [Renaming during unarisation]
    
    21 21
     ref    compiler/GHC/Tc/Gen/HsType.hs:563:56:     Note [Skolem escape prevention]
    
    22
    -ref    compiler/GHC/Tc/Gen/HsType.hs:2717:7:     Note [Matching a kind signature with a declaration]
    
    22
    +ref    compiler/GHC/Tc/Gen/HsType.hs:2718:7:     Note [Matching a kind signature with a declaration]
    
    23 23
     ref    compiler/GHC/Tc/Gen/Pat.hs:284:20:     Note [Typing patterns in pattern bindings]
    
    24
    -ref    compiler/GHC/Tc/Gen/Pat.hs:1378:7:     Note [Matching polytyped patterns]
    
    24
    +ref    compiler/GHC/Tc/Gen/Pat.hs:1380:7:     Note [Matching polytyped patterns]
    
    25 25
     ref    compiler/GHC/Tc/Gen/Sig.hs:91:10:     Note [Overview of type signatures]
    
    26
    -ref    compiler/GHC/Tc/Gen/Splice.hs:368:16:     Note [How brackets and nested splices are handled]
    
    27
    -ref    compiler/GHC/Tc/Gen/Splice.hs:543:35:     Note [PendingRnSplice]
    
    28
    -ref    compiler/GHC/Tc/Gen/Splice.hs:670:7:     Note [How brackets and nested splices are handled]
    
    26
    +ref    compiler/GHC/Tc/Gen/Splice.hs:367:16:     Note [How brackets and nested splices are handled]
    
    27
    +ref    compiler/GHC/Tc/Gen/Splice.hs:542:35:     Note [PendingRnSplice]
    
    28
    +ref    compiler/GHC/Tc/Gen/Splice.hs:669:7:     Note [How brackets and nested splices are handled]
    
    29 29
     ref    compiler/GHC/Tc/Gen/Splice.hs:909:11:     Note [How brackets and nested splices are handled]
    
    30 30
     ref    compiler/GHC/Tc/Instance/Family.hs:458:35:     Note [Constrained family instances]
    
    31
    -ref    compiler/GHC/Tc/Solver/Rewrite.hs:1015:7:     Note [Stability of rewriting]
    
    32
    -ref    compiler/GHC/Tc/TyCl.hs:1322:6:     Note [Unification variables need fresh Names]
    
    31
    +ref    compiler/GHC/Tc/Solver/Rewrite.hs:1020:7:     Note [Stability of rewriting]
    
    32
    +ref    compiler/GHC/Tc/TyCl.hs:1662:6:     Note [Unification variables need fresh Names]
    
    33 33
     ref    compiler/GHC/Tc/Types/Constraint.hs:209:9:     Note [NonCanonical Semantics]
    
    34 34
     ref    compiler/GHC/Types/Demand.hs:304:25:     Note [Preserving Boxity of results is rarely a win]
    
    35
    -ref    compiler/GHC/Unit/Module/Deps.hs:86:13:     Note [Structure of dep_boot_mods]
    
    35
    +ref    compiler/GHC/Unit/Module/Deps.hs:97:13:     Note [Structure of dep_boot_mods]
    
    36 36
     ref    compiler/GHC/Utils/Monad.hs:415:34:     Note [multiShotIO]
    
    37 37
     ref    compiler/Language/Haskell/Syntax/Binds.hs:206:31:     Note [fun_id in Match]
    
    38 38
     ref    configure.ac:205:10:     Note [Linking ghc-bin against threaded stage0 RTS]