Hannes Siebenhandl pushed to branch wip/fendor/ghci-multiple-home-units at Glasgow Haskell Compiler / GHC
Commits:
20 changed files:
- compiler/GHC.hs
- compiler/GHC/Rename/Unbound.hs
- compiler/GHC/Runtime/Context.hs
- compiler/GHC/Runtime/Eval.hs
- compiler/GHC/Tc/Module.hs
- compiler/GHC/Unit/Home/Graph.hs
- ghc/GHCi/UI.hs
- testsuite/tests/ghci/linking/dyn/T3372.hs
- testsuite/tests/ghci/prog018/prog018.stdout
- testsuite/tests/ghci/scripts/T13869.stdout
- testsuite/tests/ghci/scripts/T13997.stdout
- testsuite/tests/ghci/scripts/T17669.stdout
- testsuite/tests/ghci/scripts/T18330.stdout
- testsuite/tests/ghci/scripts/T1914.stdout
- testsuite/tests/ghci/scripts/T20217.stdout
- testsuite/tests/ghci/scripts/T20587.stdout
- testsuite/tests/ghci/scripts/T6105.stdout
- testsuite/tests/ghci/scripts/T8042.stdout
- testsuite/tests/ghci/scripts/T8042recomp.stdout
- testsuite/tests/ghci/should_run/TopEnvIface.stdout
Changes:
... | ... | @@ -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 | --
|
... | ... | @@ -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
|
... | ... | @@ -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.
|
... | ... | @@ -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)
|
... | ... | @@ -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 |
... | ... | @@ -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
|
... | ... | @@ -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 ())
|
... | ... | @@ -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 |
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 |
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. |
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 |
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 |
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. |
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. |
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. |
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. |
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. |
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. |
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 |
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.
|