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

Commits:

20 changed files:

Changes:

  • compiler/GHC.hs
    ... ... @@ -40,6 +40,7 @@ module GHC (
    40 40
             getProgramDynFlags, setProgramDynFlags,
    
    41 41
             updateProgramDynFlags,
    
    42 42
             getInteractiveDynFlags, setInteractiveDynFlags,
    
    43
    +        normaliseInteractiveDynFlags, initialiseInteractiveDynFlags,
    
    43 44
             interpretPackageEnv,
    
    44 45
     
    
    45 46
             -- * Logging
    
    ... ... @@ -157,7 +158,7 @@ module GHC (
    157 158
             getBindings, getInsts, getNamePprCtx,
    
    158 159
             findModule, lookupModule,
    
    159 160
             findQualifiedModule, lookupQualifiedModule,
    
    160
    -        lookupLoadedHomeModuleByModuleName, lookupAnyQualifiedModule,
    
    161
    +        lookupLoadedHomeModuleByModuleName, lookupAllQualifiedModuleNames,
    
    161 162
             renamePkgQualM, renameRawPkgQualM,
    
    162 163
             isModuleTrusted, moduleTrustReqs,
    
    163 164
             getNamesInScope,
    
    ... ... @@ -962,24 +963,8 @@ getProgramDynFlags = getSessionDynFlags
    962 963
     setInteractiveDynFlags :: GhcMonad m => DynFlags -> m ()
    
    963 964
     setInteractiveDynFlags dflags = do
    
    964 965
       logger <- getLogger
    
    965
    -  dflags' <- checkNewDynFlags logger dflags
    
    966
    -  dflags'' <- checkNewInteractiveDynFlags logger dflags'
    
    967
    -  modifySessionM $ \hsc_env0 -> do
    
    968
    -    let ic0 = hsc_IC hsc_env0
    
    969
    -
    
    970
    -    -- Initialise (load) plugins in the interactive environment with the new
    
    971
    -    -- DynFlags
    
    972
    -    plugin_env <- liftIO $ initializePlugins $ mkInteractiveHscEnv $
    
    973
    -                    hsc_env0 { hsc_IC = ic0 { ic_dflags = dflags'' }}
    
    974
    -
    
    975
    -    -- Update both plugins cache and DynFlags in the interactive context.
    
    976
    -    return $ hsc_env0
    
    977
    -                { hsc_IC = ic0
    
    978
    -                    { ic_plugins = hsc_plugins plugin_env
    
    979
    -                    , ic_dflags  = hsc_dflags  plugin_env
    
    980
    -                    }
    
    981
    -                }
    
    982
    -
    
    966
    +  icdflags <- normaliseInteractiveDynFlags logger dflags
    
    967
    +  modifySessionM (initialiseInteractiveDynFlags icdflags)
    
    983 968
     
    
    984 969
     -- | Get the 'DynFlags' used to evaluate interactive expressions.
    
    985 970
     getInteractiveDynFlags :: GhcMonad m => m DynFlags
    
    ... ... @@ -1084,6 +1069,28 @@ normalise_hyp fp
    1084 1069
     
    
    1085 1070
     -----------------------------------------------------------------------------
    
    1086 1071
     
    
    1072
    +normaliseInteractiveDynFlags :: MonadIO m => Logger -> DynFlags -> m DynFlags
    
    1073
    +normaliseInteractiveDynFlags logger dflags = do
    
    1074
    +  dflags' <- checkNewDynFlags logger dflags
    
    1075
    +  checkNewInteractiveDynFlags logger dflags'
    
    1076
    +
    
    1077
    +initialiseInteractiveDynFlags :: GhcMonad m => DynFlags -> HscEnv -> m HscEnv
    
    1078
    +initialiseInteractiveDynFlags dflags hsc_env0 = do
    
    1079
    +  let ic0 = hsc_IC hsc_env0
    
    1080
    +
    
    1081
    +  -- Initialise (load) plugins in the interactive environment with the new
    
    1082
    +  -- DynFlags
    
    1083
    +  plugin_env <- liftIO $ initializePlugins $ mkInteractiveHscEnv $
    
    1084
    +                  hsc_env0 { hsc_IC = ic0 { ic_dflags = dflags }}
    
    1085
    +
    
    1086
    +  -- Update both plugins cache and DynFlags in the interactive context.
    
    1087
    +  return $ hsc_env0
    
    1088
    +              { hsc_IC = ic0
    
    1089
    +                  { ic_plugins = hsc_plugins plugin_env
    
    1090
    +                  , ic_dflags  = hsc_dflags  plugin_env
    
    1091
    +                  }
    
    1092
    +              }
    
    1093
    +
    
    1087 1094
     -- | Checks the set of new DynFlags for possibly erroneous option
    
    1088 1095
     -- combinations when invoking 'setSessionDynFlags' and friends, and if
    
    1089 1096
     -- found, returns a fixed copy (if possible).
    
    ... ... @@ -1496,8 +1503,8 @@ getModuleGraph = liftM hsc_mod_graph getSession
    1496 1503
     -- TODO: this function should likely be deleted.
    
    1497 1504
     isLoaded :: GhcMonad m => ModuleName -> m Bool
    
    1498 1505
     isLoaded m = withSession $ \hsc_env -> liftIO $ do
    
    1499
    -  hmi <- HUG.lookupAnyHug (hsc_HUG hsc_env) m
    
    1500
    -  return $! isJust hmi
    
    1506
    +  hmis <- HUG.lookupAllHug (hsc_HUG hsc_env) m
    
    1507
    +  return $! not (null hmis)
    
    1501 1508
     
    
    1502 1509
     isLoadedModule :: GhcMonad m => UnitId -> ModuleName -> m Bool
    
    1503 1510
     isLoadedModule uid m = withSession $ \hsc_env -> liftIO $ do
    
    ... ... @@ -1895,18 +1902,16 @@ lookupLoadedHomeModule uid mod_name = withSession $ \hsc_env -> liftIO $ do
    1895 1902
         Just mod_info      -> return (Just (mi_module (hm_iface mod_info)))
    
    1896 1903
         _not_a_home_module -> return Nothing
    
    1897 1904
     
    
    1898
    --- TODO: this is incorrect, what if we have mulitple 'ModuleName's in our HPTs?
    
    1899
    -lookupLoadedHomeModuleByModuleName :: GhcMonad m => ModuleName -> m (Maybe Module)
    
    1905
    +lookupLoadedHomeModuleByModuleName :: GhcMonad m => ModuleName -> m (Maybe [Module])
    
    1900 1906
     lookupLoadedHomeModuleByModuleName mod_name = withSession $ \hsc_env -> liftIO $ do
    
    1901 1907
       trace_if (hsc_logger hsc_env) (text "lookupLoadedHomeModuleByModuleName" <+> ppr mod_name)
    
    1902
    -  HUG.lookupAnyHug (hsc_HUG hsc_env) mod_name >>= \case
    
    1903
    -    Just mod_info      -> return (Just (mi_module (hm_iface mod_info)))
    
    1904
    -    _not_a_home_module -> return Nothing
    
    1908
    +  HUG.lookupAllHug (hsc_HUG hsc_env) mod_name >>= \case
    
    1909
    +    []        -> return Nothing
    
    1910
    +    mod_infos -> return (Just (mi_module . hm_iface <$> mod_infos))
    
    1905 1911
     
    
    1906
    -lookupAnyQualifiedModule :: GhcMonad m => PkgQual -> ModuleName -> m Module
    
    1907
    -lookupAnyQualifiedModule NoPkgQual mod_name = withSession $ \hsc_env -> do
    
    1912
    +lookupAllQualifiedModuleNames :: GhcMonad m => PkgQual -> ModuleName -> m [Module]
    
    1913
    +lookupAllQualifiedModuleNames NoPkgQual mod_name = withSession $ \hsc_env -> do
    
    1908 1914
       home <- lookupLoadedHomeModuleByModuleName mod_name
    
    1909
    -  liftIO $ trace_if (hsc_logger hsc_env) (ppr home <+> ppr (fmap moduleUnitId home))
    
    1910 1915
       case home of
    
    1911 1916
         Just m  -> return m
    
    1912 1917
         Nothing -> liftIO $ do
    
    ... ... @@ -1916,11 +1921,11 @@ lookupAnyQualifiedModule NoPkgQual mod_name = withSession $ \hsc_env -> do
    1916 1921
           let fopts  = initFinderOpts dflags
    
    1917 1922
           res <- findExposedPackageModule fc fopts units mod_name NoPkgQual
    
    1918 1923
           case res of
    
    1919
    -        Found _ m -> return m
    
    1924
    +        Found _ m -> return [m]
    
    1920 1925
             err       -> throwOneError $ noModError hsc_env noSrcSpan mod_name err
    
    1921
    -lookupAnyQualifiedModule pkgqual mod_name =
    
    1922
    -  -- TODO: definitely wrong.
    
    1923
    -  findQualifiedModule pkgqual mod_name
    
    1926
    +lookupAllQualifiedModuleNames pkgqual mod_name = do
    
    1927
    +  m <- findQualifiedModule pkgqual mod_name
    
    1928
    +  pure [m]
    
    1924 1929
     
    
    1925 1930
     -- | Check that a module is safe to import (according to Safe Haskell).
    
    1926 1931
     --
    

  • 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
    ... ... @@ -296,9 +296,7 @@ data InteractiveImport
    296 296
           -- ^ Bring the exports of a particular module
    
    297 297
           -- (filtered by an import decl) into scope
    
    298 298
     
    
    299
    -  | IIModule ModuleName
    
    300
    -      -- TODO: change this to 'Module', does this work?
    
    301
    -      -- Much more precise
    
    299
    +  | IIModule Module
    
    302 300
           -- ^ Bring into scope the entire top-level envt of
    
    303 301
           -- of this module, including the things imported
    
    304 302
           -- into it.
    

  • compiler/GHC/Runtime/Eval.hs
    ... ... @@ -822,17 +822,12 @@ findGlobalRdrEnv hsc_env imports
    822 822
         idecls :: [LImportDecl GhcPs]
    
    823 823
         idecls = [noLocA d | IIDecl d <- imports]
    
    824 824
     
    
    825
    -    imods :: [ModuleName]
    
    825
    +    imods :: [Module]
    
    826 826
         imods = [m | IIModule m <- imports]
    
    827 827
     
    
    828
    -    mkEnv modl = do
    
    829
    -      -- TODO: revisit this, is this how we want to do it?
    
    830
    -      mMod <- HUG.lookupAnyHug (hsc_HUG hsc_env) modl
    
    831
    -      let mod = case mMod of
    
    832
    -            Nothing -> mkModule (RealUnit $ Definite $ hscActiveUnitId hsc_env) modl
    
    833
    -            Just m -> mi_module $ hm_iface m
    
    828
    +    mkEnv mod = do
    
    834 829
           mkTopLevEnv hsc_env mod >>= \case
    
    835
    -        Left err -> pure $ Left (modl, err)
    
    830
    +        Left err -> pure $ Left (moduleName mod, err)
    
    836 831
             Right env -> pure $ Right env
    
    837 832
     
    
    838 833
     mkTopLevEnv :: HscEnv -> Module -> IO (Either String GlobalRdrEnv)
    

  • 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
    
    ... ... @@ -2091,15 +2090,18 @@ runTcInteractive hsc_env thing_inside
    2091 2090
                                                      , let local_gres = filter isLocalGRE gres
    
    2092 2091
                                                      , not (null local_gres) ]) ]
    
    2093 2092
     
    
    2094
    -       ; let getOrphans m mb_pkg = fmap (\iface -> mi_module iface
    
    2095
    -                                          : dep_orphs (mi_deps iface))
    
    2096
    -                                 (loadSrcInterface (text "runTcInteractive") m
    
    2097
    -                                                   NotBoot mb_pkg)
    
    2093
    +       ; let getOrphansForModuleName m mb_pkg = do
    
    2094
    +              iface <- loadSrcInterface (text "runTcInteractive") m NotBoot mb_pkg
    
    2095
    +              pure $ mi_module iface : dep_orphs (mi_deps iface)
    
    2096
    +
    
    2097
    +             getOprhansForModule m = do
    
    2098
    +              iface <- loadModuleInterface (text "runTcInteractive") m
    
    2099
    +              pure $ mi_module iface : dep_orphs (mi_deps iface)
    
    2098 2100
     
    
    2099 2101
            ; !orphs <- fmap (force . concat) . forM (ic_imports icxt) $ \i ->
    
    2100 2102
                 case i of                   -- force above: see #15111
    
    2101
    -                IIModule n -> getOrphans n NoPkgQual
    
    2102
    -                IIDecl i   -> getOrphans (unLoc (ideclName i))
    
    2103
    +                IIModule n -> getOprhansForModule n
    
    2104
    +                IIDecl i   -> getOrphansForModuleName (unLoc (ideclName i))
    
    2103 2105
                                              (renameRawPkgQual (hsc_unit_env hsc_env) (unLoc $ ideclName i) (ideclPkgQual i))
    
    2104 2106
     
    
    2105 2107
     
    

  • compiler/GHC/Unit/Home/Graph.hs
    ... ... @@ -34,7 +34,7 @@ module GHC.Unit.Home.Graph
    34 34
       , lookupHug
    
    35 35
       , lookupHugByModule
    
    36 36
       , lookupHugUnit
    
    37
    -  , lookupAnyHug
    
    37
    +  , lookupAllHug
    
    38 38
       , memberHugHomeModule
    
    39 39
       , memberHugHomeInstalledModule
    
    40 40
     
    
    ... ... @@ -91,6 +91,7 @@ import GHC.Data.Graph.Directed
    91 91
     import GHC.Types.Annotations
    
    92 92
     import GHC.Types.CompleteMatch
    
    93 93
     import GHC.Core.InstEnv
    
    94
    +import GHC.Utils.Monad (mapMaybeM)
    
    94 95
     
    
    95 96
     
    
    96 97
     -- | Get all 'CompleteMatches' (arising from COMPLETE pragmas) present across
    
    ... ... @@ -254,22 +255,17 @@ lookupHug hug uid mod = do
    254 255
         Nothing -> pure Nothing
    
    255 256
         Just hue -> lookupHpt (homeUnitEnv_hpt hue) mod
    
    256 257
     
    
    257
    --- TODO: this should not be merged, where else could we try to search for modules?
    
    258
    -lookupAnyHug :: HomeUnitGraph -> ModuleName -> IO (Maybe HomeModInfo)
    
    259
    -lookupAnyHug hug mod = firstJustM $ flip fmap (Set.toList $ unitEnv_keys hug) $ \uid -> do
    
    260
    -  case unitEnv_lookup_maybe uid hug of
    
    261
    -    -- Really, here we want "lookup HPT" rather than unitEnvLookup
    
    262
    -    Nothing -> pure Nothing
    
    263
    -    Just hue -> lookupHpt (homeUnitEnv_hpt hue) mod
    
    258
    +-- | Lookup all 'HomeModInfo' that have the same 'ModuleName' as the given 'ModuleName'.
    
    259
    +-- 'ModuleName's are not unique in the case of multiple home units, so there can be
    
    260
    +-- more than one possible 'HomeModInfo'.
    
    261
    +lookupAllHug :: HomeUnitGraph -> ModuleName -> IO [HomeModInfo]
    
    262
    +lookupAllHug hug mod = mapMaybeM lookupModuleName (Set.toList $ unitEnv_keys hug)
    
    264 263
       where
    
    265
    -    firstJustM :: Monad f => [f (Maybe a)] -> f (Maybe a)
    
    266
    -    firstJustM [] = pure Nothing
    
    267
    -    firstJustM (x:xs) = do
    
    268
    -      ma <- x
    
    269
    -      case ma of
    
    270
    -        Nothing -> firstJustM xs
    
    271
    -        Just a -> pure $ Just a
    
    272
    -
    
    264
    +    lookupModuleName uid =
    
    265
    +      case unitEnv_lookup_maybe uid hug of
    
    266
    +        -- Really, here we want "lookup HPT" rather than unitEnvLookup
    
    267
    +        Nothing -> pure Nothing
    
    268
    +        Just hue -> lookupHpt (homeUnitEnv_hpt hue) mod
    
    273 269
     
    
    274 270
     -- | Lookup the 'HomeModInfo' of a 'Module' in the 'HomeUnitGraph' (via the 'HomePackageTable' of the corresponding unit)
    
    275 271
     lookupHugByModule :: Module -> HomeUnitGraph -> IO (Maybe HomeModInfo)
    
    ... ... @@ -283,10 +279,12 @@ lookupHugByModule mod hug
    283 279
     lookupHugUnit :: UnitId -> HomeUnitGraph -> Maybe HomeUnitEnv
    
    284 280
     lookupHugUnit = unitEnv_lookup_maybe
    
    285 281
     
    
    282
    +-- | Check whether the 'Module' is part of the given 'HomeUnitGraph'.
    
    286 283
     memberHugHomeModule :: Module -> HomeUnitGraph -> Bool
    
    287 284
     memberHugHomeModule mod =
    
    288 285
       memberHugHomeInstalledModule (fmap toUnitId mod)
    
    289 286
     
    
    287
    +-- | Check whether the 'InstalledModule' is part of the given 'HomeUnitGraph'.
    
    290 288
     memberHugHomeInstalledModule :: InstalledModule -> HomeUnitGraph -> Bool
    
    291 289
     memberHugHomeInstalledModule mod hug =
    
    292 290
       case unitEnv_lookup_maybe (moduleUnit mod) hug of
    

  • ghc/GHCi/UI.hs
    ... ... @@ -558,7 +558,7 @@ interactiveUI config srcs maybe_exprs = do
    558 558
        hsc_env <- GHC.getSession
    
    559 559
        let !in_multi = length (hsc_all_home_unit_ids hsc_env) > 3
    
    560 560
             -- We force this to make sure we don't retain the hsc_env when reloading
    
    561
    -        -- The check is `> 2`, since we now always have at least two home units.
    
    561
    +        -- The check is `> 3`, since we now always have at least two home units.
    
    562 562
             -- TODO: if everything goes well, this check should be deleted once
    
    563 563
             -- this PR has lifted the multiple home unit restrictions
    
    564 564
        empty_cache <- liftIO newIfaceCache
    
    ... ... @@ -1023,7 +1023,7 @@ getInfoForPrompt = do
    1023 1023
                           | otherwise           = unLoc (ideclName d)
    
    1024 1024
     
    
    1025 1025
             modules_names =
    
    1026
    -             ['*':(moduleNameString m) | IIModule m <- rev_imports] ++
    
    1026
    +             ['*':(moduleNameString (moduleName m)) | IIModule m <- rev_imports] ++
    
    1027 1027
                  [moduleNameString (myIdeclName d) | IIDecl d <- rev_imports]
    
    1028 1028
             line = 1 + line_number st
    
    1029 1029
     
    
    ... ... @@ -1444,7 +1444,6 @@ runStmt input step = do
    1444 1444
     
    
    1445 1445
         setDumpFilePrefix :: GHC.GhcMonad m => InteractiveContext -> m () -- #17500
    
    1446 1446
         setDumpFilePrefix ic = do
    
    1447
    -        -- TODO: wrong
    
    1448 1447
             dflags <- GHC.getInteractiveDynFlags
    
    1449 1448
             GHC.setInteractiveDynFlags dflags { dumpPrefix = modStr ++ "." }
    
    1450 1449
           where
    
    ... ... @@ -2122,7 +2121,7 @@ addModule :: GhciMonad m => [FilePath] -> m ()
    2122 2121
     addModule files = do
    
    2123 2122
       revertCAFs -- always revert CAFs on load/add.
    
    2124 2123
       files' <- mapM expandPath files
    
    2125
    -  targets <- mapM (\m -> GHC.guessTarget m Nothing Nothing) files'
    
    2124
    +  targets <- mapM (\m -> GHC.guessTarget m (Just interactiveSessionUnitId) Nothing) files'
    
    2126 2125
       targets' <- filterM checkTarget targets
    
    2127 2126
       -- remove old targets with the same id; e.g. for :add *M
    
    2128 2127
       mapM_ GHC.removeTarget [ tid | Target { targetId = tid } <- targets' ]
    
    ... ... @@ -2155,7 +2154,7 @@ addModule files = do
    2155 2154
     unAddModule :: GhciMonad m => [FilePath] -> m ()
    
    2156 2155
     unAddModule files = do
    
    2157 2156
       files' <- mapM expandPath files
    
    2158
    -  targets <- mapM (\m -> GHC.guessTarget m Nothing Nothing) files'
    
    2157
    +  targets <- mapM (\m -> GHC.guessTarget m (Just interactiveSessionUnitId) Nothing) files'
    
    2159 2158
       let removals = [ tid | Target { targetId = tid } <- targets ]
    
    2160 2159
       mapM_ GHC.removeTarget removals
    
    2161 2160
       _ <- doLoadAndCollectInfo (Unadd $ length removals) LoadAllTargets
    
    ... ... @@ -2279,7 +2278,7 @@ setContextAfterLoad keep_ctxt (Just graph) = do
    2279 2278
                   -- We import the module with a * iff
    
    2280 2279
                   --   - it is interpreted, and
    
    2281 2280
                   --   - -XSafe is off (it doesn't allow *-imports)
    
    2282
    -        let new_ctx | star_ok   = [mkIIModule (GHC.moduleName m)]
    
    2281
    +        let new_ctx | star_ok   = [mkIIModule m]
    
    2283 2282
                         | otherwise = [mkIIDecl   (GHC.moduleName m)]
    
    2284 2283
             setContextKeepingPackageModules keep_ctxt new_ctx
    
    2285 2284
     
    
    ... ... @@ -2699,7 +2698,7 @@ guessCurrentModule cmd = do
    2699 2698
       imports <- GHC.getContext
    
    2700 2699
       case imports of
    
    2701 2700
         [] -> throwGhcException $ CmdLineError (':' : cmd ++ ": no current module")
    
    2702
    -    IIModule m : _ -> GHC.findQualifiedModule NoPkgQual m
    
    2701
    +    IIModule m : _ -> pure m
    
    2703 2702
         IIDecl d : _ -> do
    
    2704 2703
           pkgqual <- GHC.renameRawPkgQualM (unLoc $ ideclName d) (ideclPkgQual d)
    
    2705 2704
           GHC.findQualifiedModule pkgqual (unLoc (ideclName d))
    
    ... ... @@ -2829,8 +2828,9 @@ addModulesToContext starred unstarred = restoreContextOnFailure $ do
    2829 2828
     
    
    2830 2829
     addModulesToContext_ :: GhciMonad m => [ModuleName] -> [ModuleName] -> m ()
    
    2831 2830
     addModulesToContext_ starred unstarred = do
    
    2832
    -   mapM_ addII (map mkIIModule starred ++ map mkIIDecl unstarred)
    
    2833
    -   setGHCContextFromGHCiState
    
    2831
    +  starredModules <- traverse lookupModuleName starred
    
    2832
    +  mapM_ addII (map mkIIModule starredModules ++ map mkIIDecl unstarred)
    
    2833
    +  setGHCContextFromGHCiState
    
    2834 2834
     
    
    2835 2835
     remModulesFromContext :: GhciMonad m => [ModuleName] -> [ModuleName] -> m ()
    
    2836 2836
     remModulesFromContext  starred unstarred = do
    
    ... ... @@ -2896,9 +2896,9 @@ checkAdd ii = do
    2896 2896
       dflags <- getDynFlags
    
    2897 2897
       let safe = safeLanguageOn dflags
    
    2898 2898
       case ii of
    
    2899
    -    IIModule modname
    
    2899
    +    IIModule mod
    
    2900 2900
            | safe -> throwGhcException $ CmdLineError "can't use * imports with Safe Haskell"
    
    2901
    -       | otherwise -> wantInterpretedModuleName modname >> return ()
    
    2901
    +       | otherwise -> checkInterpretedModule mod >> return ()
    
    2902 2902
     
    
    2903 2903
         IIDecl d -> do
    
    2904 2904
            let modname = unLoc (ideclName d)
    
    ... ... @@ -2966,13 +2966,13 @@ getImplicitPreludeImports iidecls = do
    2966 2966
     -- -----------------------------------------------------------------------------
    
    2967 2967
     -- Utils on InteractiveImport
    
    2968 2968
     
    
    2969
    -mkIIModule :: ModuleName -> InteractiveImport
    
    2969
    +mkIIModule :: Module -> InteractiveImport
    
    2970 2970
     mkIIModule = IIModule
    
    2971 2971
     
    
    2972 2972
     mkIIDecl :: ModuleName -> InteractiveImport
    
    2973 2973
     mkIIDecl = IIDecl . simpleImportDecl
    
    2974 2974
     
    
    2975
    -iiModules :: [InteractiveImport] -> [ModuleName]
    
    2975
    +iiModules :: [InteractiveImport] -> [Module]
    
    2976 2976
     iiModules is = [m | IIModule m <- is]
    
    2977 2977
     
    
    2978 2978
     isIIModule :: InteractiveImport -> Bool
    
    ... ... @@ -2980,7 +2980,7 @@ isIIModule (IIModule _) = True
    2980 2980
     isIIModule _ = False
    
    2981 2981
     
    
    2982 2982
     iiModuleName :: InteractiveImport -> ModuleName
    
    2983
    -iiModuleName (IIModule m) = m
    
    2983
    +iiModuleName (IIModule m) = moduleName m
    
    2984 2984
     iiModuleName (IIDecl d)   = unLoc (ideclName d)
    
    2985 2985
     
    
    2986 2986
     preludeModuleName :: ModuleName
    
    ... ... @@ -3239,22 +3239,30 @@ newDynFlags interactive_only minus_opts = do
    3239 3239
                 let oldFlags = HUG.homeUnitEnv_dflags homeUnitEnv
    
    3240 3240
                 -- TODO: perhaps write custom version of parseDynamicFlagsCmdLine which gives us more control over the errors and warnings
    
    3241 3241
                 (newFlags, _, _) <- DynFlags.parseDynamicFlagsCmdLine logger oldFlags lopts
    
    3242
    -            let newFlags' = if uid == interactiveGhciUnitId
    
    3243
    -                  then wopt_unset newFlags Opt_WarnUnusedPackages
    
    3244
    -                  else newFlags
    
    3242
    +            newFlags' <-
    
    3243
    +              if uid == interactiveGhciUnitId || uid == interactiveSessionUnitId
    
    3244
    +                then do
    
    3245
    +                  -- TODO: document this
    
    3246
    +                  let dflags1 = wopt_unset newFlags Opt_WarnUnusedPackages
    
    3247
    +                  if uid == interactiveGhciUnitId
    
    3248
    +                    then
    
    3249
    +                      GHC.normaliseInteractiveDynFlags logger dflags1
    
    3250
    +                    else
    
    3251
    +                      pure dflags1
    
    3252
    +                else
    
    3253
    +                  pure newFlags
    
    3245 3254
                 pure (uid, oldFlags, newFlags')
    
    3246 3255
               must_reload <- GHC.updateProgramDynFlags True updates
    
    3247 3256
     
    
    3248 3257
               -- update and check interactive dynflags
    
    3249 3258
               -- TODO: document the relation ship between the interactive unit and in the interactive context
    
    3250 3259
               icdflags <- hsc_dflags <$> GHC.getSession
    
    3251
    -          GHC.setInteractiveDynFlags icdflags
    
    3260
    +          modifySessionM (GHC.initialiseInteractiveDynFlags icdflags)
    
    3252 3261
     
    
    3253 3262
               -- if the package flags changed, reset the context and link
    
    3254 3263
               -- the new packages.
    
    3255 3264
               hsc_env <- GHC.getSession
    
    3256 3265
               let dflags2 = hsc_dflags hsc_env
    
    3257
    -          let interp  = hscInterp hsc_env
    
    3258 3266
               when must_reload $ do
    
    3259 3267
                 when (verbosity dflags2 > 0) $
    
    3260 3268
                   liftIO . putStrLn $
    
    ... ... @@ -3263,30 +3271,41 @@ newDynFlags interactive_only minus_opts = do
    3263 3271
                 -- Clear caches and eventually defined breakpoints. (#1620)
    
    3264 3272
                 clearCaches
    
    3265 3273
     
    
    3266
    -            let units = concatMap (preloadUnits . HUG.homeUnitEnv_units) (Foldable.toList $ hsc_HUG hsc_env)
    
    3267
    -            liftIO $ Loader.loadPackages interp hsc_env units
    
    3268
    -            -- package flags changed, we can't re-use any of the old context
    
    3269
    -            setContextAfterLoad False Nothing -- TODO: recheck whether this is necessary
    
    3270
    -
    
    3271
    -          -- TODO extract into separate function
    
    3272
    -          let ld0length   = length $ ldInputs dflags0
    
    3273
    -              fmrk0length = length $ cmdlineFrameworks dflags0
    
    3274
    -
    
    3275
    -              newLdInputs     = drop ld0length (ldInputs dflags2)
    
    3276
    -              newCLFrameworks = drop fmrk0length (cmdlineFrameworks dflags2)
    
    3274
    +            reloadPackages hsc_env
    
    3277 3275
     
    
    3278
    -              dflags'  = dflags2 { ldInputs = newLdInputs
    
    3279
    -                                 , cmdlineFrameworks = newCLFrameworks
    
    3280
    -                                 }
    
    3281
    -              hsc_env' = hscSetFlags dflags' hsc_env
    
    3282
    -
    
    3283
    -          when (not (null newLdInputs && null newCLFrameworks)) $
    
    3284
    -            liftIO $ Loader.loadCmdLineLibs (hscInterp hsc_env') hsc_env'
    
    3276
    +            reloadLinkerOptions hsc_env dflags0 dflags2
    
    3285 3277
     
    
    3286 3278
           idflags <- hsc_dflags <$> GHC.getSession
    
    3287 3279
           installInteractivePrint (interactivePrint idflags) False
    
    3288 3280
           return ()
    
    3289 3281
     
    
    3282
    +reloadPackages :: GhciMonad m => HscEnv -> m ()
    
    3283
    +reloadPackages hsc_env = do
    
    3284
    +  let
    
    3285
    +      units =
    
    3286
    +        concatMap (preloadUnits . HUG.homeUnitEnv_units)
    
    3287
    +                  (Foldable.toList $ hsc_HUG hsc_env)
    
    3288
    +  liftIO $ Loader.loadPackages (hscInterp hsc_env) hsc_env units
    
    3289
    +  -- package flags changed, we can't re-use any of the old context
    
    3290
    +  setContextAfterLoad False Nothing
    
    3291
    +
    
    3292
    +reloadLinkerOptions :: MonadIO m => HscEnv -> DynFlags -> DynFlags -> m ()
    
    3293
    +reloadLinkerOptions hsc_env old_flags new_flags = do
    
    3294
    +  let
    
    3295
    +
    
    3296
    +    ld0length   = length $ ldInputs old_flags
    
    3297
    +    fmrk0length = length $ cmdlineFrameworks old_flags
    
    3298
    +
    
    3299
    +    newLdInputs     = drop ld0length (ldInputs new_flags)
    
    3300
    +    newCLFrameworks = drop fmrk0length (cmdlineFrameworks new_flags)
    
    3301
    +
    
    3302
    +    dflags'  = new_flags { ldInputs = newLdInputs
    
    3303
    +                         , cmdlineFrameworks = newCLFrameworks
    
    3304
    +                         }
    
    3305
    +    hsc_env' = hscSetFlags dflags' hsc_env
    
    3306
    +
    
    3307
    +  when (not (null newLdInputs && null newCLFrameworks)) $
    
    3308
    +    liftIO $ Loader.loadCmdLineLibs (hscInterp hsc_env') hsc_env'
    
    3290 3309
     
    
    3291 3310
     unknownFlagsErr :: GhciMonad m => [String] -> m ()
    
    3292 3311
     unknownFlagsErr fs = mapM_ (\f -> reportError (GhciUnknownFlag f (suggestions f))) fs
    
    ... ... @@ -3428,7 +3447,7 @@ showImports = do
    3428 3447
           trans_ctx = transient_ctx st
    
    3429 3448
     
    
    3430 3449
           show_one (IIModule star_m)
    
    3431
    -          = ":module +*" ++ moduleNameString star_m
    
    3450
    +          = ":module +*" ++ moduleNameString (moduleName star_m)
    
    3432 3451
           show_one (IIDecl imp) = showPpr dflags imp
    
    3433 3452
     
    
    3434 3453
       prel_iidecls <- getImplicitPreludeImports (rem_ctx ++ trans_ctx)
    
    ... ... @@ -3734,11 +3753,11 @@ completeBreakpoint = wrapCompleter spaces $ \w -> do -- #3000
    3734 3753
             filterM GHC.moduleIsInterpreted hmods
    
    3735 3754
     
    
    3736 3755
         -- Return all possible bids for a given Module
    
    3737
    -    bidsByModule :: GhciMonad m => [ModuleName] -> Module -> m [String]
    
    3756
    +    bidsByModule :: GhciMonad m => [Module] -> Module -> m [String]
    
    3738 3757
         bidsByModule nonquals mod = do
    
    3739 3758
           (_, decls) <- getModBreak mod
    
    3740 3759
           let bids = nub $ declPath <$> elems decls
    
    3741
    -      pure $ case (moduleName mod) `elem` nonquals of
    
    3760
    +      pure $ case mod `elem` nonquals of
    
    3742 3761
                   True  -> bids
    
    3743 3762
                   False -> (combineModIdent (showModule mod)) <$> bids
    
    3744 3763
     
    
    ... ... @@ -4143,8 +4162,7 @@ breakSwitch (arg1:rest)
    4143 4162
        | all isDigit arg1 = do
    
    4144 4163
             imports <- GHC.getContext
    
    4145 4164
             case iiModules imports of
    
    4146
    -           (mn : _) -> do
    
    4147
    -              md <- lookupModuleName mn
    
    4165
    +           (md : _) -> do
    
    4148 4166
                   breakByModuleLine md (read arg1) rest
    
    4149 4167
                [] -> do
    
    4150 4168
                   liftIO $ putStrLn "No modules are loaded with debugging support."
    
    ... ... @@ -4276,8 +4294,7 @@ list2 [arg] | all isDigit arg = do
    4276 4294
         case iiModules imports of
    
    4277 4295
             [] -> liftIO $ putStrLn "No module to list"
    
    4278 4296
             (mn : _) -> do
    
    4279
    -          md <- lookupModuleName mn
    
    4280
    -          listModuleLine md (read arg)
    
    4297
    +          listModuleLine mn (read arg)
    
    4281 4298
     list2 [arg1,arg2] | looksLikeModuleName arg1, all isDigit arg2 = do
    
    4282 4299
             md <- wantInterpretedModule arg1
    
    4283 4300
             listModuleLine md (read arg2)
    
    ... ... @@ -4536,7 +4553,17 @@ lookupModuleName :: GHC.GhcMonad m => ModuleName -> m Module
    4536 4553
     lookupModuleName mName = lookupQualifiedModuleName NoPkgQual mName
    
    4537 4554
     
    
    4538 4555
     lookupQualifiedModuleName :: GHC.GhcMonad m => PkgQual -> ModuleName -> m Module
    
    4539
    -lookupQualifiedModuleName = GHC.lookupAnyQualifiedModule
    
    4556
    +lookupQualifiedModuleName qual modl = do
    
    4557
    +  GHC.lookupAllQualifiedModuleNames qual modl >>= \case
    
    4558
    +    [] -> throwGhcException (CmdLineError ("module '" ++ str ++ "' could not be found."))
    
    4559
    +    [m] -> pure m
    
    4560
    +    ms -> throwGhcException (CmdLineError ("module name '" ++ str ++ "' is ambiguous;\n" ++ errorMsg ms))
    
    4561
    +  where
    
    4562
    +    str = moduleNameString modl
    
    4563
    +    errorMsg ms = intercalate "\n"
    
    4564
    +      [ "- " ++ unitIdString (toUnitId (moduleUnit m)) ++ ":" ++ moduleNameString (moduleName m)
    
    4565
    +      | m <- ms
    
    4566
    +      ]
    
    4540 4567
     
    
    4541 4568
     isMainUnitModule :: Module -> Bool
    
    4542 4569
     isMainUnitModule m = GHC.moduleUnit m == mainUnit
    
    ... ... @@ -4586,15 +4613,19 @@ wantInterpretedModule str = wantInterpretedModuleName (GHC.mkModuleName str)
    4586 4613
     
    
    4587 4614
     wantInterpretedModuleName :: GHC.GhcMonad m => ModuleName -> m Module
    
    4588 4615
     wantInterpretedModuleName modname = do
    
    4589
    -   modl <- lookupModuleName modname
    
    4590
    -   let str = moduleNameString modname
    
    4591
    -   hug <- hsc_HUG <$> GHC.getSession
    
    4592
    -   unless (HUG.memberHugHomeModule modl hug) $
    
    4593
    -      throwGhcException (CmdLineError ("module '" ++ str ++ "' is from another package;\nthis command requires an interpreted module"))
    
    4594
    -   is_interpreted <- GHC.moduleIsInterpreted modl
    
    4595
    -   when (not is_interpreted) $
    
    4596
    -       throwGhcException (CmdLineError ("module '" ++ str ++ "' is not interpreted; try \':add *" ++ str ++ "' first"))
    
    4597
    -   return modl
    
    4616
    +  modl <- lookupModuleName modname
    
    4617
    +  checkInterpretedModule modl
    
    4618
    +
    
    4619
    +checkInterpretedModule :: GHC.GhcMonad m => Module -> m Module
    
    4620
    +checkInterpretedModule modl = do
    
    4621
    +  let str = moduleNameString $ moduleName modl
    
    4622
    +  hug <- hsc_HUG <$> GHC.getSession
    
    4623
    +  unless (HUG.memberHugHomeModule modl hug) $
    
    4624
    +    throwGhcException (CmdLineError ("module '" ++ str ++ "' is from another package;\nthis command requires an interpreted module"))
    
    4625
    +  is_interpreted <- GHC.moduleIsInterpreted modl
    
    4626
    +  when (not is_interpreted) $
    
    4627
    +      throwGhcException (CmdLineError ("module '" ++ str ++ "' is not interpreted; try \':add *" ++ str ++ "' first"))
    
    4628
    +  return modl
    
    4598 4629
     
    
    4599 4630
     wantNameFromInterpretedModule :: GHC.GhcMonad m
    
    4600 4631
                                   => (Name -> SDoc -> m ())
    

  • testsuite/tests/ghci/linking/dyn/T3372.hs
    ... ... @@ -60,7 +60,7 @@ load (f,mn) = do target <- GHC.guessTarget f Nothing Nothing
    60 60
                      GHC.liftIO $ putStrLn ("Load " ++ showSuccessFlag res)
    
    61 61
                      --
    
    62 62
                      m <- GHC.findModule (GHC.mkModuleName mn) Nothing
    
    63
    -                 GHC.setContext [GHC.IIModule $ GHC.moduleName $ m]
    
    63
    +                 GHC.setContext [GHC.IIModule m]
    
    64 64
         where showSuccessFlag GHC.Succeeded = "succeeded"
    
    65 65
               showSuccessFlag GHC.Failed    = "failed"
    
    66 66
     
    

  • testsuite/tests/ghci/prog018/prog018.stdout
    1
    -[1 of 3] Compiling A                ( A.hs, interpreted )
    
    2
    -[2 of 3] Compiling B                ( B.hs, interpreted )
    
    3
    -[3 of 3] Compiling C                ( C.hs, interpreted )
    
    1
    +[1 of 3] Compiling A                ( A.hs, interpreted )[main]
    
    2
    +[2 of 3] Compiling B                ( B.hs, interpreted )[main]
    
    3
    +[3 of 3] Compiling C                ( C.hs, interpreted )[interactive-session]
    
    4 4
     A.hs:5:1: warning: [GHC-62161] [-Wincomplete-patterns (in -Wextra)]
    
    5 5
         Pattern match(es) are non-exhaustive
    
    6 6
         In an equation for ‘incompletePattern’:
    
    ... ... @@ -18,7 +18,7 @@ C.hs:6:7: error: [GHC-88464]
    18 18
         Variable not in scope: variableNotInScope :: ()
    
    19 19
     
    
    20 20
     Failed, two modules loaded.
    
    21
    -[3 of 3] Compiling C                ( C.hs, interpreted )
    
    21
    +[3 of 3] Compiling C                ( C.hs, interpreted )[interactive-session]
    
    22 22
     C.hs:6:7: error: [GHC-88464]
    
    23 23
         Variable not in scope: variableNotInScope :: ()
    
    24 24
     
    

  • testsuite/tests/ghci/scripts/T13869.stdout
    1
    -[1 of 1] Compiling T13869A          ( T13869a.hs, interpreted )
    
    1
    +[1 of 1] Compiling T13869A          ( T13869a.hs, interpreted )[interactive-session]
    
    2 2
     Ok, one module loaded.
    
    3 3
     Ok, one module reloaded.
    
    4 4
     Ok, unloaded all modules.
    
    5 5
     Ok, no modules to be reloaded.
    
    6
    -[1 of 1] Compiling T13869A          ( T13869a.hs, interpreted )
    
    6
    +[1 of 1] Compiling T13869A          ( T13869a.hs, interpreted )[interactive-session]
    
    7 7
     Ok, one module loaded.
    
    8
    -[2 of 2] Compiling T13869B          ( T13869b.hs, interpreted )
    
    8
    +[2 of 2] Compiling T13869B          ( T13869b.hs, interpreted )[interactive-session]
    
    9 9
     Ok, one module added.
    
    10 10
     Ok, two modules reloaded.
    
    11
    -[1 of 2] Compiling T13869A          ( T13869a.hs, interpreted )
    
    12
    -[2 of 2] Compiling T13869B          ( T13869b.hs, interpreted )
    
    11
    +[1 of 2] Compiling T13869A          ( T13869a.hs, interpreted )[interactive-session]
    
    12
    +[2 of 2] Compiling T13869B          ( T13869b.hs, interpreted )[interactive-session]
    
    13 13
     Ok, two modules loaded.
    
    14 14
     Ok, one module unadded.

  • testsuite/tests/ghci/scripts/T13997.stdout
    1
    -[1 of 2] Compiling Bug2             ( Bug2.hs, Bug2.o )
    
    2
    -[2 of 2] Compiling Bug              ( Bug.hs, Bug.o )
    
    1
    +[1 of 2] Compiling Bug2             ( Bug2.hs, Bug2.o )[main]
    
    2
    +[2 of 2] Compiling Bug              ( Bug.hs, Bug.o )[interactive-session]
    
    3 3
     Ok, two modules loaded.
    
    4
    -[1 of 3] Compiling New              ( New.hs, New.o )
    
    5
    -[2 of 3] Compiling Bug2             ( Bug2.hs, Bug2.o ) [Source file changed]
    
    6
    -[3 of 3] Compiling Bug              ( Bug.hs, Bug.o ) [Bug2 changed]
    
    4
    +[1 of 3] Compiling New              ( New.hs, New.o )[main]
    
    5
    +[2 of 3] Compiling Bug2             ( Bug2.hs, Bug2.o )[main] [Source file changed]
    
    6
    +[3 of 3] Compiling Bug              ( Bug.hs, Bug.o )[interactive-session] [Bug2 changed]
    
    7 7
     Ok, three modules reloaded.
    
    8 8
     True

  • testsuite/tests/ghci/scripts/T17669.stdout
    1
    -[1 of 1] Compiling T17669           ( T17669.hs, T17669.o )
    
    1
    +[1 of 1] Compiling T17669           ( T17669.hs, T17669.o )[interactive-session]
    
    2 2
     Ok, one module loaded.
    
    3 3
     this
    
    4
    -[1 of 1] Compiling T17669           ( T17669.hs, T17669.o ) [Source file changed]
    
    4
    +[1 of 1] Compiling T17669           ( T17669.hs, T17669.o )[interactive-session] [Source file changed]
    
    5 5
     Ok, one module reloaded.
    
    6 6
     that

  • testsuite/tests/ghci/scripts/T18330.stdout
    1
    -GHCi, version 9.3.20211019: https://www.haskell.org/ghc/  :? for help
    
    2
    -ghci> [1 of 2] Compiling Main             ( shell.hs, interpreted )
    
    3
    -[2 of 2] Linking shell
    
    1
    +GHCi, version 9.13.20250422: https://www.haskell.org/ghc/  :? for help
    
    2
    +ghci> [1 of 2] Compiling Main             ( shell.hs, interpreted )[interactive-session]
    
    4 3
     Ok, one module loaded.
    
    5
    -ghci> ghci> [1 of 1] Compiling T18330           ( T18330.hs, interpreted )
    
    6
    -Ok, one module loaded.
    
    7
    -ghci> ghci> [1 of 1] Compiling T18330           ( T18330.hs, interpreted ) [T18330.extra changed]
    
    4
    +ghci> ghci> [1 of 1] Compiling T18330           ( T18330.hs, interpreted )[interactive-session]
    
    8 5
     Ok, one module loaded.
    
    6
    +ghci> ghci> [1 of 1] Compiling T18330           ( T18330.hs, interpreted )[interactive-session] [T18330.extra changed]
    
    7
    +Ok, one module reloaded.
    
    9 8
     ghci> Leaving GHCi.

  • testsuite/tests/ghci/scripts/T1914.stdout
    1
    -[1 of 2] Compiling T1914B           ( T1914B.hs, interpreted )
    
    2
    -[2 of 2] Compiling T1914A           ( T1914A.hs, interpreted )
    
    1
    +[1 of 2] Compiling T1914B           ( T1914B.hs, interpreted )[main]
    
    2
    +[2 of 2] Compiling T1914A           ( T1914A.hs, interpreted )[interactive-session]
    
    3 3
     Ok, two modules loaded.
    
    4
    -[2 of 2] Compiling T1914A           ( T1914A.hs, interpreted ) [Source file changed]
    
    4
    +[2 of 2] Compiling T1914A           ( T1914A.hs, interpreted )[interactive-session] [Source file changed]
    
    5 5
     Failed, one module reloaded.
    
    6
    -[2 of 2] Compiling T1914A           ( T1914A.hs, interpreted )
    
    6
    +[2 of 2] Compiling T1914A           ( T1914A.hs, interpreted )[interactive-session]
    
    7 7
     Ok, two modules reloaded.

  • testsuite/tests/ghci/scripts/T20217.stdout
    1
    -[1 of 3] Compiling T20217A[boot]    ( T20217A.hs-boot, nothing )
    
    2
    -[2 of 3] Compiling T20217A          ( T20217A.hs, nothing )
    
    3
    -[3 of 3] Compiling T20217           ( T20217.hs, nothing )
    
    1
    +[1 of 3] Compiling T20217A[boot]    ( T20217A.hs-boot, nothing )[main]
    
    2
    +[2 of 3] Compiling T20217A          ( T20217A.hs, nothing )[main]
    
    3
    +[3 of 3] Compiling T20217           ( T20217.hs, nothing )[interactive-session]
    
    4 4
     Ok, three modules loaded.
    
    5 5
     Ok, three modules reloaded.

  • testsuite/tests/ghci/scripts/T20587.stdout
    1
    -[1 of 1] Compiling B
    
    1
    +[1 of 1] Compiling B[interactive-session]
    
    2 2
     Ok, one module loaded.
    
    3
    -[1 of 1] Compiling B [Source file changed]
    
    3
    +[1 of 1] Compiling B[interactive-session] [Source file changed]
    
    4 4
     Ok, one module reloaded.

  • testsuite/tests/ghci/scripts/T6105.stdout
    1
    -[1 of 1] Compiling T6105            ( T6105.hs, interpreted )
    
    1
    +[1 of 1] Compiling T6105            ( T6105.hs, interpreted )[interactive-session]
    
    2 2
     Ok, one module loaded.
    
    3
    -[1 of 1] Compiling T6105            ( T6105.hs, interpreted )
    
    3
    +[1 of 1] Compiling T6105            ( T6105.hs, interpreted )[interactive-session]
    
    4 4
     Ok, one module reloaded.

  • testsuite/tests/ghci/scripts/T8042.stdout
    1
    -[1 of 3] Compiling T8042B           ( T8042B.hs, T8042B.o )
    
    2
    -[2 of 3] Compiling T8042C           ( T8042C.hs, interpreted )
    
    3
    -[3 of 3] Compiling T8042A           ( T8042A.hs, interpreted )
    
    1
    +[1 of 3] Compiling T8042B           ( T8042B.hs, T8042B.o )[main]
    
    2
    +[2 of 3] Compiling T8042C           ( T8042C.hs, interpreted )[main]
    
    3
    +[3 of 3] Compiling T8042A           ( T8042A.hs, interpreted )[interactive-session]
    
    4 4
     Ok, three modules loaded.
    
    5
    -[3 of 3] Compiling T8042A           ( T8042A.hs, T8042A.o ) [Source file changed]
    
    5
    +[3 of 3] Compiling T8042A           ( T8042A.hs, T8042A.o )[interactive-session] [Source file changed]
    
    6 6
     Ok, three modules reloaded.
    
    7
    -[2 of 3] Compiling T8042C           ( T8042C.hs, interpreted )
    
    8
    -[3 of 3] Compiling T8042A           ( T8042A.hs, interpreted )
    
    7
    +[2 of 3] Compiling T8042C           ( T8042C.hs, interpreted )[main]
    
    8
    +[3 of 3] Compiling T8042A           ( T8042A.hs, interpreted )[interactive-session]
    
    9 9
     Ok, three modules loaded.

  • testsuite/tests/ghci/scripts/T8042recomp.stdout
    1
    -[1 of 2] Compiling T8042B           ( T8042B.hs, T8042B.o )
    
    2
    -[2 of 2] Compiling T8042A           ( T8042A.hs, T8042A.o )
    
    1
    +[1 of 2] Compiling T8042B           ( T8042B.hs, T8042B.o )[main]
    
    2
    +[2 of 2] Compiling T8042A           ( T8042A.hs, T8042A.o )[interactive-session]
    
    3 3
     Ok, two modules loaded.
    
    4
    -[2 of 2] Compiling T8042A           ( T8042A.hs, interpreted )
    
    4
    +[2 of 2] Compiling T8042A           ( T8042A.hs, interpreted )[interactive-session]
    
    5 5
     Ok, two modules loaded.
    
    6 6
     Breakpoint 0 activated at T8042A.hs:1:44-56

  • testsuite/tests/ghci/should_run/TopEnvIface.stdout
    1
    -[1 of 2] Compiling TopEnvIface2     ( TopEnvIface2.hs, interpreted )
    
    2
    -[2 of 2] Compiling TopEnvIface      ( TopEnvIface.hs, interpreted )
    
    1
    +[1 of 2] Compiling TopEnvIface2     ( TopEnvIface2.hs, interpreted )[main]
    
    2
    +[2 of 2] Compiling TopEnvIface      ( TopEnvIface.hs, interpreted )[main]
    
    3 3
     Ok, two modules loaded.
    
    4 4
     "I should be printed twice"
    
    5 5
     Leaving GHCi.