From 4e4d47a0d483655d35b0e1a2dddd5666a18e5639 Mon Sep 17 00:00:00 2001
From: Jade <Nils.Jadefalke@gmail.com>
Date: Mon, 22 Jan 2024 16:35:03 +0100
Subject: [PATCH] GHCi: Improve response to unloading, loading and reloading
modules
Fixes #13869
---
docs/users_guide/9.10.1-notes.rst | 4 +
ghc/GHCi/UI.hs | 117 ++++++++++++--------
testsuite/tests/driver/T8526/T8526.stdout | 2 +-
testsuite/tests/ghci/prog018/prog018.stdout | 2 +-
testsuite/tests/ghci/scripts/T13869.script | 13 +++
testsuite/tests/ghci/scripts/T13869.stdout | 14 +++
testsuite/tests/ghci/scripts/T13869a.hs | 1 +
testsuite/tests/ghci/scripts/T13869b.hs | 1 +
testsuite/tests/ghci/scripts/T13997.stdout | 2 +-
testsuite/tests/ghci/scripts/T17669.stdout | 2 +-
testsuite/tests/ghci/scripts/T1914.stdout | 4 +-
testsuite/tests/ghci/scripts/T20217.stdout | 2 +-
testsuite/tests/ghci/scripts/T20587.stdout | 2 +-
testsuite/tests/ghci/scripts/T6105.stdout | 2 +-
testsuite/tests/ghci/scripts/T8042.stdout | 2 +-
testsuite/tests/ghci/scripts/all.T | 3 +-
testsuite/tests/ghci/should_run/all.T | 1 -
17 files changed, 114 insertions(+), 60 deletions(-)
create mode 100644 testsuite/tests/ghci/scripts/T13869.script
create mode 100644 testsuite/tests/ghci/scripts/T13869.stdout
create mode 100644 testsuite/tests/ghci/scripts/T13869a.hs
create mode 100644 testsuite/tests/ghci/scripts/T13869b.hs
diff --git a/docs/users_guide/9.10.1-notes.rst b/docs/users_guide/9.10.1-notes.rst
index b8b43fec159f..c331a3a26a0f 100644
--- a/docs/users_guide/9.10.1-notes.rst
+++ b/docs/users_guide/9.10.1-notes.rst
@@ -194,6 +194,10 @@ WebAssembly backend
GHCi
~~~~
+- GHCi now differentiates between adding, unadding, loading, unloading and reloading
+ in its responses to using the respective commands. The output with `-fshow-loaded-modules`
+ is not changed to keep backwards compatibility for tooling.
+
Runtime system
~~~~~~~~~~~~~~
diff --git a/ghc/GHCi/UI.hs b/ghc/GHCi/UI.hs
index 3a9dfd92d6a3..0a5b842e8595 100644
--- a/ghc/GHCi/UI.hs
+++ b/ghc/GHCi/UI.hs
@@ -1714,8 +1714,7 @@ changeDirectory dir = do
trySuccess :: GhciMonad m => m SuccessFlag -> m SuccessFlag
trySuccess act =
handleSourceError (\e -> do printErrAndMaybeExit e -- immediately exit fith failure if in ghc -e
- return Failed) $ do
- act
+ pure Failed) act
-----------------------------------------------------------------------------
-- :edit
@@ -1913,7 +1912,7 @@ checkModule m = do
(text "local names: " <+> ppr loc)
_ -> empty
return True
- afterLoad (successIf ok) False
+ afterLoad (successIf ok) Check
-----------------------------------------------------------------------------
-- :doc
@@ -2018,6 +2017,13 @@ instancesCmd s = do
-----------------------------------------------------------------------------
-- :load, :add, :unadd, :reload
+-- these are mainly used for displaying a more informative response
+data LoadType = Add !Int | Unadd !Int | Load | Reload | Check
+
+isReload :: LoadType -> Bool
+isReload Reload = True
+isReload _ = False
+
-- | Sets '-fdefer-type-errors' if 'defer' is true, executes 'load' and unsets
-- '-fdefer-type-errors' again if it has not been set before.
wrapDeferTypeErrors :: GHC.GhcMonad m => m a -> m a
@@ -2065,7 +2071,7 @@ loadModule' files = do
clearCaches
GHC.setTargets targets
- doLoadAndCollectInfo False LoadAllTargets
+ doLoadAndCollectInfo Load LoadAllTargets
if gopt Opt_GhciLeakCheck dflags
then do
@@ -2088,7 +2094,7 @@ addModule files = do
-- remove old targets with the same id; e.g. for :add *M
mapM_ GHC.removeTarget [ tid | Target { targetId = tid } <- targets' ]
mapM_ GHC.addTarget targets'
- _ <- doLoadAndCollectInfo False LoadAllTargets
+ _ <- doLoadAndCollectInfo (Add $ length targets') LoadAllTargets
return ()
where
checkTarget :: GhciMonad m => Target -> m Bool
@@ -2120,8 +2126,9 @@ unAddModule :: GhciMonad m => [FilePath] -> m ()
unAddModule files = do
files' <- mapM expandPath files
targets <- mapM (\m -> GHC.guessTarget m Nothing Nothing) files'
- mapM_ GHC.removeTarget [ tid | Target { targetId = tid } <- targets ]
- _ <- doLoadAndCollectInfo False LoadAllTargets
+ let removals = [ tid | Target { targetId = tid } <- targets ]
+ mapM_ GHC.removeTarget removals
+ _ <- doLoadAndCollectInfo (Unadd $ length removals) LoadAllTargets
return ()
-- | @:reload@ command
@@ -2129,7 +2136,7 @@ reloadModule :: GhciMonad m => String -> m ()
reloadModule m = do
session <- GHC.getSession
let home_unit = homeUnitId (hsc_home_unit session)
- ok <- doLoadAndCollectInfo True (loadTargets home_unit)
+ ok <- doLoadAndCollectInfo Reload (loadTargets home_unit)
when (failed ok) failIfExprEvalMode
where
loadTargets hu | null m = LoadAllTargets
@@ -2150,11 +2157,11 @@ reloadModuleDefer = wrapDeferTypeErrors . reloadModule
-- since those commands are designed to be used by editors and
-- tooling, it's useless to collect this data for normal GHCi
-- sessions.
-doLoadAndCollectInfo :: GhciMonad m => Bool -> LoadHowMuch -> m SuccessFlag
-doLoadAndCollectInfo retain_context howmuch = do
+doLoadAndCollectInfo :: GhciMonad m => LoadType -> LoadHowMuch -> m SuccessFlag
+doLoadAndCollectInfo load_type howmuch = do
doCollectInfo <- isOptionSet CollectInfo
- doLoad retain_context howmuch >>= \case
+ doLoad load_type howmuch >>= \case
Succeeded | doCollectInfo -> do
mod_summaries <- GHC.mgModSummaries <$> getModuleGraph
-- MP: :set +c code path only works in single package mode atm, hence
@@ -2164,11 +2171,11 @@ doLoadAndCollectInfo retain_context howmuch = do
v <- mod_infos <$> getGHCiState
!newInfos <- collectInfo v loaded
modifyGHCiState (\st -> st { mod_infos = newInfos })
- return Succeeded
- flag -> return flag
+ pure Succeeded
+ flag -> pure flag
-doLoad :: GhciMonad m => Bool -> LoadHowMuch -> m SuccessFlag
-doLoad retain_context howmuch = do
+doLoad :: GhciMonad m => LoadType -> LoadHowMuch -> m SuccessFlag
+doLoad load_type howmuch = do
-- turn off breakpoints before we load: we can't turn them off later, because
-- the ModBreaks will have gone away.
discardActiveBreakPoints
@@ -2177,31 +2184,31 @@ doLoad retain_context howmuch = do
-- Enable buffering stdout and stderr as we're compiling. Keeping these
-- handles unbuffered will just slow the compilation down, especially when
-- compiling in parallel.
- MC.bracket (liftIO $ do hSetBuffering stdout LineBuffering
- hSetBuffering stderr LineBuffering)
- (\_ ->
- liftIO $ do hSetBuffering stdout NoBuffering
- hSetBuffering stderr NoBuffering) $ \_ -> do
+ let setBuffering t = liftIO $ do
+ hSetBuffering stdout t
+ hSetBuffering stderr t
+ MC.bracket_ (setBuffering LineBuffering) (setBuffering NoBuffering) $ do
hmis <- ifaceCache <$> getGHCiState
-- If GHCi message gets its own configuration at some stage then this will need to be
-- modified to 'embedUnknownDiagnostic'.
ok <- trySuccess $ GHC.loadWithCache (Just hmis) (mkUnknownDiagnostic . GHCiMessage) howmuch
- afterLoad ok retain_context
- return ok
+ afterLoad ok load_type
+ pure ok
+
afterLoad
:: GhciMonad m
=> SuccessFlag
- -> Bool -- keep the remembered_ctx, as far as possible (:reload)
+ -> LoadType
-> m ()
-afterLoad ok retain_context = do
+afterLoad ok load_type = do
revertCAFs -- always revert CAFs on load.
discardTickArrays
loaded_mods <- getLoadedModules
- modulesLoadedMsg ok loaded_mods
+ modulesLoadedMsg ok loaded_mods load_type
graph <- GHC.getModuleGraph
- setContextAfterLoad retain_context (Just graph)
+ setContextAfterLoad (isReload load_type) (Just graph)
setContextAfterLoad :: GhciMonad m => Bool -> Maybe GHC.ModuleGraph -> m ()
setContextAfterLoad keep_ctxt Nothing = do
@@ -2285,35 +2292,49 @@ keepPackageImports = filterM is_pkg_import
-modulesLoadedMsg :: GHC.GhcMonad m => SuccessFlag -> [GHC.ModSummary] -> m ()
-modulesLoadedMsg ok mods = do
+modulesLoadedMsg :: GHC.GhcMonad m => SuccessFlag -> [GHC.ModSummary] -> LoadType -> m ()
+modulesLoadedMsg ok mods load_type = do
dflags <- getDynFlags
- msg <- if gopt Opt_ShowLoadedModules dflags
- then do
- mod_names <- mapM mod_name mods
- let mod_commas
- | null mods = text "none."
- | otherwise = hsep (punctuate comma mod_names) <> text "."
- return $ status <> text ", modules loaded:" <+> mod_commas
- else do
- return $ status <> text ","
- <+> speakNOf (length mods) (text "module") <+> "loaded."
-
when (verbosity dflags > 0) $ do
- rendered_msg <- showSDocForUser' msg
+ mod_names <- mapM mod_name mods
+ rendered_msg <- showSDocForUser' $
+ if gopt Opt_ShowLoadedModules dflags
+ then loaded_msg mod_names
+ else msg
liftIO $ putStrLn rendered_msg
where
- status = case ok of
- Failed -> text "Failed"
- Succeeded -> text "Ok"
+ num_mods = length mods
+ none_loaded = num_mods == 0
+
+ loaded_msg names =
+ let mod_commas
+ | null mods = text "none."
+ | otherwise = hsep (punctuate comma names) <> text "."
+ in status <> text ", modules loaded:" <+> mod_commas
+
+ msg = status <> comma <+> msg' <> dot
+ msg' = case load_type of
+ Reload -> if none_loaded
+ then "no modules to be reloaded"
+ else n_mods num_mods "reloaded"
+ Load -> if none_loaded
+ then "unloaded all modules"
+ else n_mods num_mods "loaded"
+ Check -> n_mods 1 "checked"
+ Add n -> n_mods n "added"
+ Unadd n -> n_mods n "unadded"
+ n_mods amount action = speakNOf amount "module" <+> action
+
+ status | Succeeded <- ok = "Ok"
+ | otherwise = "Failed"
mod_name mod = do
is_interpreted <- GHC.moduleIsBootOrNotObjectLinkable mod
- return $ if is_interpreted
- then ppr (GHC.ms_mod mod)
- else ppr (GHC.ms_mod mod)
- <+> parens (text $ normalise $ msObjFilePath mod)
- -- Fix #9887
+ pure $ if is_interpreted
+ then ppr (GHC.ms_mod mod)
+ else ppr (GHC.ms_mod mod)
+ <+> parens (text $ normalise $ msObjFilePath mod)
+ -- Fix #9887
-- | Run an 'ExceptT' wrapped 'GhcMonad' while handling source errors
-- and printing 'throwE' strings to 'stderr'. If in expression
diff --git a/testsuite/tests/driver/T8526/T8526.stdout b/testsuite/tests/driver/T8526/T8526.stdout
index 0255fa3b853a..bee206666c87 100644
--- a/testsuite/tests/driver/T8526/T8526.stdout
+++ b/testsuite/tests/driver/T8526/T8526.stdout
@@ -2,5 +2,5 @@
Ok, one module loaded.
True
[1 of 1] Compiling A ( A.hs, interpreted )
-Ok, one module loaded.
+Ok, one module reloaded.
False
diff --git a/testsuite/tests/ghci/prog018/prog018.stdout b/testsuite/tests/ghci/prog018/prog018.stdout
index 34e40f9facfa..c2a118fb5efb 100644
--- a/testsuite/tests/ghci/prog018/prog018.stdout
+++ b/testsuite/tests/ghci/prog018/prog018.stdout
@@ -22,4 +22,4 @@ Failed, two modules loaded.
C.hs:6:7: error: [GHC-88464]
Variable not in scope: variableNotInScope :: ()
-Failed, two modules loaded.
+Failed, two modules reloaded.
diff --git a/testsuite/tests/ghci/scripts/T13869.script b/testsuite/tests/ghci/scripts/T13869.script
new file mode 100644
index 000000000000..7fbd57cd7617
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T13869.script
@@ -0,0 +1,13 @@
+:set -v1
+:load T13869a.hs
+:reload
+
+:load
+:reload
+
+:load T13869a.hs
+:add T13869b.hs
+:reload
+
+:load T13869a.hs T13869b.hs
+:unadd T13869.hs
diff --git a/testsuite/tests/ghci/scripts/T13869.stdout b/testsuite/tests/ghci/scripts/T13869.stdout
new file mode 100644
index 000000000000..1690c7739e08
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T13869.stdout
@@ -0,0 +1,14 @@
+[1 of 1] Compiling T13869A ( T13869a.hs, interpreted )
+Ok, one module loaded.
+Ok, one module reloaded.
+Ok, unloaded all modules.
+Ok, no modules to be reloaded.
+[1 of 1] Compiling T13869A ( T13869a.hs, interpreted )
+Ok, one module loaded.
+[2 of 2] Compiling T13869B ( T13869b.hs, interpreted )
+Ok, one module added.
+Ok, two modules reloaded.
+[1 of 2] Compiling T13869A ( T13869a.hs, interpreted )
+[2 of 2] Compiling T13869B ( T13869b.hs, interpreted )
+Ok, two modules loaded.
+Ok, one module unadded.
diff --git a/testsuite/tests/ghci/scripts/T13869a.hs b/testsuite/tests/ghci/scripts/T13869a.hs
new file mode 100644
index 000000000000..577724e64eac
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T13869a.hs
@@ -0,0 +1 @@
+module T13869A where
diff --git a/testsuite/tests/ghci/scripts/T13869b.hs b/testsuite/tests/ghci/scripts/T13869b.hs
new file mode 100644
index 000000000000..bfdc2afca390
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T13869b.hs
@@ -0,0 +1 @@
+module T13869B where
diff --git a/testsuite/tests/ghci/scripts/T13997.stdout b/testsuite/tests/ghci/scripts/T13997.stdout
index 4df5e29535ff..5bec6c3ab1f4 100644
--- a/testsuite/tests/ghci/scripts/T13997.stdout
+++ b/testsuite/tests/ghci/scripts/T13997.stdout
@@ -4,5 +4,5 @@ Ok, two modules loaded.
[1 of 3] Compiling New ( New.hs, New.o )
[2 of 3] Compiling Bug2 ( Bug2.hs, Bug2.o ) [Source file changed]
[3 of 3] Compiling Bug ( Bug.hs, Bug.o ) [Bug2 changed]
-Ok, three modules loaded.
+Ok, three modules reloaded.
True
diff --git a/testsuite/tests/ghci/scripts/T17669.stdout b/testsuite/tests/ghci/scripts/T17669.stdout
index 4d3d1718bacc..0c677914f0e2 100644
--- a/testsuite/tests/ghci/scripts/T17669.stdout
+++ b/testsuite/tests/ghci/scripts/T17669.stdout
@@ -2,5 +2,5 @@
Ok, one module loaded.
this
[1 of 1] Compiling T17669 ( T17669.hs, T17669.o ) [Source file changed]
-Ok, one module loaded.
+Ok, one module reloaded.
that
diff --git a/testsuite/tests/ghci/scripts/T1914.stdout b/testsuite/tests/ghci/scripts/T1914.stdout
index dfeeeca727d8..726337e92894 100644
--- a/testsuite/tests/ghci/scripts/T1914.stdout
+++ b/testsuite/tests/ghci/scripts/T1914.stdout
@@ -2,6 +2,6 @@
[2 of 2] Compiling T1914A ( T1914A.hs, interpreted )
Ok, two modules loaded.
[2 of 2] Compiling T1914A ( T1914A.hs, interpreted ) [Source file changed]
-Failed, one module loaded.
+Failed, one module reloaded.
[2 of 2] Compiling T1914A ( T1914A.hs, interpreted )
-Ok, two modules loaded.
+Ok, two modules reloaded.
diff --git a/testsuite/tests/ghci/scripts/T20217.stdout b/testsuite/tests/ghci/scripts/T20217.stdout
index 49a5244c5f1d..af01296bc18f 100644
--- a/testsuite/tests/ghci/scripts/T20217.stdout
+++ b/testsuite/tests/ghci/scripts/T20217.stdout
@@ -2,4 +2,4 @@
[2 of 3] Compiling T20217A ( T20217A.hs, nothing )
[3 of 3] Compiling T20217 ( T20217.hs, nothing )
Ok, three modules loaded.
-Ok, three modules loaded.
+Ok, three modules reloaded.
diff --git a/testsuite/tests/ghci/scripts/T20587.stdout b/testsuite/tests/ghci/scripts/T20587.stdout
index 6ca6d9f15f09..4e5c8de19c11 100644
--- a/testsuite/tests/ghci/scripts/T20587.stdout
+++ b/testsuite/tests/ghci/scripts/T20587.stdout
@@ -1,4 +1,4 @@
[1 of 1] Compiling B
Ok, one module loaded.
[1 of 1] Compiling B [Source file changed]
-Ok, one module loaded.
+Ok, one module reloaded.
diff --git a/testsuite/tests/ghci/scripts/T6105.stdout b/testsuite/tests/ghci/scripts/T6105.stdout
index 9a8190f26c6d..4ed950f0d774 100644
--- a/testsuite/tests/ghci/scripts/T6105.stdout
+++ b/testsuite/tests/ghci/scripts/T6105.stdout
@@ -1,4 +1,4 @@
[1 of 1] Compiling T6105 ( T6105.hs, interpreted )
Ok, one module loaded.
[1 of 1] Compiling T6105 ( T6105.hs, interpreted )
-Ok, one module loaded.
+Ok, one module reloaded.
diff --git a/testsuite/tests/ghci/scripts/T8042.stdout b/testsuite/tests/ghci/scripts/T8042.stdout
index 9a06c4118919..b95a080daf1b 100644
--- a/testsuite/tests/ghci/scripts/T8042.stdout
+++ b/testsuite/tests/ghci/scripts/T8042.stdout
@@ -3,7 +3,7 @@
[3 of 3] Compiling T8042A ( T8042A.hs, interpreted )
Ok, three modules loaded.
[3 of 3] Compiling T8042A ( T8042A.hs, T8042A.o ) [Source file changed]
-Ok, three modules loaded.
+Ok, three modules reloaded.
[2 of 3] Compiling T8042C ( T8042C.hs, interpreted )
[3 of 3] Compiling T8042A ( T8042A.hs, interpreted )
Ok, three modules loaded.
diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T
index eb5fccb1fafc..4b194f3a96a1 100755
--- a/testsuite/tests/ghci/scripts/all.T
+++ b/testsuite/tests/ghci/scripts/all.T
@@ -380,4 +380,5 @@ test('T22817', normal, ghci_script, ['T22817.script'])
test('T22908', normal, ghci_script, ['T22908.script'])
test('T23062', normal, ghci_script, ['T23062.script'])
test('T16468', normal, ghci_script, ['T16468.script'])
-test('T23686', normal, ghci_script, ['T23686.script'])
\ No newline at end of file
+test('T23686', normal, ghci_script, ['T23686.script'])
+test('T13869', extra_files(['T13869a.hs', 'T13869b.hs']), ghci_script, ['T13869.script'])
diff --git a/testsuite/tests/ghci/should_run/all.T b/testsuite/tests/ghci/should_run/all.T
index 4f56d1e97170..0306e448557b 100644
--- a/testsuite/tests/ghci/should_run/all.T
+++ b/testsuite/tests/ghci/should_run/all.T
@@ -94,4 +94,3 @@ test('GhciMainIs', just_ghci, compile_and_run, ['-main-is otherMain'])
test('LargeBCO', [extra_files(['LargeBCO_A.hs']), req_interp, extra_hc_opts("-O -fbyte-code-and-object-code -fprefer-byte-code")], compile_and_run, [''])
test('T24115', just_ghci + [extra_run_opts("-e ':add T24115.hs'")], ghci_script, ['T24115.script'])
-
--
GitLab